diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 1767eb06145..64bea259e15 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -3213,11 +3213,10 @@ type FSharpCheckProjectResults builder.SourceFiles |> Array.ofList |> Array.collect (fun x -> - match builder.GetCheckResultsForFileInProjectEvenIfStale x with - | Some partialCheckResults -> - match partialCheckResults.TryPeekTcInfoWithExtras() with - | Some (_, tcInfoExtras) -> tcInfoExtras.TcSymbolUses.GetUsesOfSymbol symbol.Item - | _ -> [||] + let partialCheckResults = builder.GetCheckResultsForFileInProjectEvenIfStale x + + match partialCheckResults.TryPeekTcInfoWithExtras() with + | Some (_, tcInfoExtras) -> tcInfoExtras.TcSymbolUses.GetUsesOfSymbol symbol.Item | _ -> [||]) | Choice2Of2 tcSymbolUses -> tcSymbolUses.GetUsesOfSymbol symbol.Item @@ -3243,11 +3242,10 @@ type FSharpCheckProjectResults builder.SourceFiles |> Array.ofList |> Array.map (fun x -> - match builder.GetCheckResultsForFileInProjectEvenIfStale x with - | Some partialCheckResults -> - match partialCheckResults.TryPeekTcInfoWithExtras() with - | Some (_, tcInfoExtras) -> tcInfoExtras.TcSymbolUses - | _ -> TcSymbolUses.Empty + let partialCheckResults = builder.GetCheckResultsForFileInProjectEvenIfStale x + + match partialCheckResults.TryPeekTcInfoWithExtras() with + | Some (_, tcInfoExtras) -> tcInfoExtras.TcSymbolUses | _ -> TcSymbolUses.Empty) | Choice2Of2 tcSymbolUses -> [| tcSymbolUses |] diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 5403a37b86b..bc3ddf12814 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -4,10 +4,8 @@ namespace FSharp.Compiler.CodeAnalysis open System open System.Collections.Generic -open System.Collections.Immutable open System.Diagnostics open System.IO -open System.Threading open Internal.Utilities.Library open Internal.Utilities.Collections open FSharp.Compiler @@ -94,6 +92,8 @@ module IncrementalBuilderEventTesting = module Tc = CheckExpressions type internal FSharpFile = { + Name: string + HasSignature: bool Range: range Source: FSharpSource Flags: bool * bool @@ -105,25 +105,23 @@ module IncrementalBuildSyntaxTree = type ParseResult = ParsedInput * range * string * (PhasedDiagnostic * FSharpDiagnosticSeverity) array - /// Information needed to lazily parse a file to get a ParsedInput. Internally uses a weak cache. + /// Information needed to lazily parse a file to get a ParsedInput. Internally uses GraphNodes to cache results. [] type SyntaxTree ( tcConfig: TcConfig, fileParsed: Event, lexResourceManager, file: FSharpFile, - hasSignature + timeStamp: DateTime ) = - let fileName = file.Source.FilePath - let sourceRange = file.Range let source = file.Source let isLastCompiland = file.Flags let skippedImplFilePlaceholder sigName = ParsedInput.ImplFile( ParsedImplFileInput( - fileName, + file.Name, false, sigName, [], @@ -133,10 +131,11 @@ module IncrementalBuildSyntaxTree = { ConditionalDirectives = []; CodeComments = [] }, Set.empty ) - ), sourceRange, fileName, [||] + ) let parse (source: FSharpSource) = node { + let fileName = source.FilePath IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBEParsed fileName) use _ = Activity.start "IncrementalBuildSyntaxTree.parse" @@ -161,7 +160,7 @@ module IncrementalBuildSyntaxTree = fileParsed.Trigger fileName - return input, sourceRange, fileName, diagnosticsLogger.GetDiagnostics() + return input, file.Range, fileName, diagnosticsLogger.GetDiagnostics() with exn -> let msg = sprintf "unexpected failure in SyntaxTree.parse\nerror = %s" (exn.ToString()) System.Diagnostics.Debug.Assert(false, msg) @@ -169,19 +168,19 @@ module IncrementalBuildSyntaxTree = return Unchecked.defaultof<_> } - /// Parse the given file and return the given input. + /// Parse the source and cache the result in a GraphNode. member val ParseNode : GraphNode = parse source |> GraphNode - member _.Invalidate() = - SyntaxTree(tcConfig, fileParsed, lexResourceManager, file, hasSignature) + member _.Invalidate(timeStamp) = + SyntaxTree(tcConfig, fileParsed, lexResourceManager, file, timeStamp) member _.Skip = skippedImplFilePlaceholder - member _.FileName = fileName + member _.FileName = file.Name - member _.HasSignature = hasSignature + member _.HasSignature = file.HasSignature - member _.SourceRange = sourceRange + member _.TimeStamp = timeStamp /// Accumulated results of type checking. The minimum amount of state in order to continue type-checking following files. [] @@ -234,101 +233,81 @@ module ValueOption = | ValueSome x -> Some x | _ -> None -type private TypeCheck = TcInfo * TcResultsSinkImpl * CheckedImplFile option * string +type private SingleFileDiagnostics = (PhasedDiagnostic * FSharpDiagnosticSeverity) array -/// Bound model of an underlying syntax and typed tree. -type BoundModel private ( - tcConfig: TcConfig, +/// Represents the interim state of checking an assembly +[] +type internal PartialCheckResults( + tcInfo: GraphNode, + diags: GraphNode, + tcInfoExtras: GraphNode, + timeStamp: DateTime, + tcConfig, tcGlobals, - tcImports: TcImports, - keepAssemblyContents, keepAllBackgroundResolutions, - keepAllBackgroundSymbolUses, - enableBackgroundItemKeyStoreAndSemanticClassification, - beforeFileChecked: Event, - fileChecked: Event, - prevTcInfo: TcInfo, - syntaxTreeOpt: SyntaxTree option, - ?tcStateOpt: GraphNode * GraphNode + tcImports ) = + member _.TcInfo = tcInfo - let getTypeCheck (syntaxTree: SyntaxTree) : NodeCode = - node { - let! input, _sourceRange, fileName, parseErrors = syntaxTree.ParseNode.GetOrComputeValue() - use _ = Activity.start "BoundModel.TypeCheck" [|Activity.Tags.fileName, fileName|] + member _.Diags = diags - 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) + /// Max timestamp of the inputs so far. + member _.TimeStamp = timeStamp - 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 + member _.TcConfig = tcConfig - let! (tcEnvAtEndOfFile, topAttribs, implFile, ccuSigForFile), tcState = - CheckOneInput ( - (fun () -> hadParseErrors || diagnosticsLogger.ErrorCount > 0), - tcConfig, tcImports, - tcGlobals, - None, - TcResultsSink.WithSink sink, - prevTcInfo.tcState, input ) - |> NodeCode.FromCancellable + member _.TcGlobals = tcGlobals - fileChecked.Trigger fileName + member _.TcImports = tcImports - let newErrors = Array.append parseErrors (capturingDiagnosticsLogger.Diagnostics |> List.toArray) - let tcEnvAtEndOfFile = if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls + member _.TryPeekTcInfo() = tcInfo.TryPeekValue() |> ValueOption.toOption + + member _.TryPeekTcInfoWithExtras() = + (tcInfo.TryPeekValue(), tcInfoExtras.TryPeekValue()) + ||> ValueOption.map2 (fun a b -> a, b) + |> ValueOption.toOption + + member _.GetOrComputeTcInfo() = tcInfo.GetOrComputeValue() + + member _.GetOrComputeTcInfoExtras() = tcInfoExtras.GetOrComputeValue() + + member _.GetOrComputeTcInfoWithExtras() = node { + let! tcInfo = tcInfo.GetOrComputeValue() + let! tcInfoExtras = tcInfoExtras.GetOrComputeValue() + return tcInfo, tcInfoExtras + } - 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 + member _.GetOrComputeItemKeyStoreIfEnabled() = + node { + let! info = tcInfoExtras.GetOrComputeValue() + return info.itemKeyStore } - let skippedImplemetationTypeCheck = - match syntaxTreeOpt, prevTcInfo.sigNameOpt with - | 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) -> - { - tcState = tcState - tcEnvAtEndOfFile = tcState.TcEnvFromImpls - moduleNamesDict = prevTcInfo.moduleNamesDict - latestCcuSigForFile = Some ccuSigForFile - tcDiagnosticsRev = prevTcInfo.tcDiagnosticsRev - topAttribs = Some topAttribs - tcDependencyFiles = fileName :: prevTcInfo.tcDependencyFiles - sigNameOpt = Some(fileName, qualifiedName) - }) - | _ -> None - - let getTcInfo (typeCheck: GraphNode) = + member _.GetOrComputeSemanticClassificationIfEnabled() = node { - let! tcInfo , _, _, _ = typeCheck.GetOrComputeValue() - return tcInfo - } |> GraphNode + let! info = tcInfoExtras.GetOrComputeValue() + return info.semanticClassificationKeyStore + } + + member _.Finalize(finalTcInfo) = + PartialCheckResults(GraphNode.FromResult finalTcInfo, GraphNode.FromResult [||], tcInfoExtras, DateTime.UtcNow, tcConfig, tcGlobals, tcImports) + +type private TypeCheck = TcInfo * TcResultsSinkImpl * CheckedImplFile option * string * SingleFileDiagnostics + +type PartialCheckResultsBuilder( + tcImports: TcImports, + tcConfig: TcConfig, + tcGlobals, + enableBackgroundItemKeyStoreAndSemanticClassification, + keepAssemblyContents, + keepAllBackgroundResolutions, + keepAllBackgroundSymbolUses, + beforeFileChecked: Event, + fileChecked: Event + ) = let getTcInfoExtras (typeCheck: GraphNode) = node { - let! _ , sink, implFile, fileName = typeCheck.GetOrComputeValue() + let! _ , sink, implFile, fileName, _ = typeCheck.GetOrComputeValue() // Build symbol keys let itemKeyStore, semanticClassification = if enableBackgroundItemKeyStoreAndSemanticClassification then @@ -365,111 +344,128 @@ type BoundModel private ( } } |> 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 |> GraphNode - match tcStateOpt with - | Some tcState -> tcState - | _ -> - match skippedImplemetationTypeCheck with - | Some info -> - // For skipped implementation sources do full type check only when requested. - GraphNode.FromResult info, getTcInfoExtras typeCheckNode - | _ -> - let tcInfoExtras = getTcInfoExtras typeCheckNode - // start computing extras, so that typeCheckNode can be GC'd quickly - tcInfoExtras.GetOrComputeValue() |> Async.AwaitNodeCode |> Async.Ignore |> Async.Start - getTcInfo typeCheckNode, tcInfoExtras - - member val TcInfo = tcInfo - - member val TcInfoExtras = tcInfoExtras + + let getTypeCheck (prevTcInfo: GraphNode) (syntaxTree: SyntaxTree) : NodeCode = + node { + let! prevTcInfo = prevTcInfo.GetOrComputeValue() + let! input, _sourceRange, fileName, parseErrors = syntaxTree.ParseNode.GetOrComputeValue() + use _ = Activity.start "BoundModel.TypeCheck" [|Activity.Tags.fileName, fileName|] - member _.TcConfig = tcConfig + 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) - member _.TcGlobals = tcGlobals + 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 - member _.TcImports = tcImports + let! (tcEnvAtEndOfFile, topAttribs, implFile, ccuSigForFile), tcState = + CheckOneInput ( + (fun () -> hadParseErrors || diagnosticsLogger.ErrorCount > 0), + tcConfig, tcImports, + tcGlobals, + None, + TcResultsSink.WithSink sink, + prevTcInfo.tcState, input ) + |> NodeCode.FromCancellable - 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 - } + fileChecked.Trigger fileName - member this.Next(syntaxTree) = node { - let! tcInfo = this.TcInfo.GetOrComputeValue() - return - BoundModel( - tcConfig, - tcGlobals, - tcImports, - keepAssemblyContents, - keepAllBackgroundResolutions, - keepAllBackgroundSymbolUses, - enableBackgroundItemKeyStoreAndSemanticClassification, - beforeFileChecked, - fileChecked, - tcInfo, - Some syntaxTree - ) - } + 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, newErrors + } - member this.Finish(finalTcDiagnosticsRev, finalTopAttribs) = + let skippedImplemetationTypeCheck prevTcInfo (syntaxTree: SyntaxTree) = node { - let! tcInfo = this.TcInfo.GetOrComputeValue() - let finishState = { tcInfo with tcDiagnosticsRev = finalTcDiagnosticsRev; topAttribs = finalTopAttribs } - return - BoundModel( - tcConfig, - tcGlobals, - tcImports, - keepAssemblyContents, - keepAllBackgroundResolutions, - keepAllBackgroundSymbolUses, - enableBackgroundItemKeyStoreAndSemanticClassification, - beforeFileChecked, - fileChecked, - prevTcInfo, - syntaxTreeOpt, - (GraphNode.FromResult finishState, this.TcInfoExtras) - ) + match prevTcInfo.sigNameOpt with + | Some (_, qualifiedName) when syntaxTree.HasSignature -> + let input = syntaxTree.Skip qualifiedName + let fileName = syntaxTree.FileName + return + SkippedImplFilePlaceholder(tcConfig, tcImports, tcGlobals, 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, qualifiedName) + }) + | _ -> return None } - 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 - ) + member _.Create(tcInfo, diags, tcInfoExtras, timeStamp) = + PartialCheckResults(tcInfo, diags, tcInfoExtras, timeStamp, tcConfig, tcGlobals, tcImports) + /// Return TcInfoExtras node for initial PartialCheckResults. + member _.DefaultTcInfoExtras(tcInfo) = + let defaultTypeCheck = tcInfo, TcResultsSinkImpl(tcGlobals), None, "default typecheck - no syntaxTree", [||] + getTcInfoExtras (GraphNode.FromResult defaultTypeCheck) + + /// Return PartialCheckResults for next file in compilation order. + member _.Next(priorCheckresults: PartialCheckResults, syntaxTree: SyntaxTree) = + + // Pass on dependecies time stamp if newer. + // Implementation files with backing signatures do not contribute to the partial check timestamp. + let timeStamp = + if syntaxTree.HasSignature then priorCheckresults.TimeStamp else max syntaxTree.TimeStamp priorCheckresults.TimeStamp + + let typeCheckNode = getTypeCheck priorCheckresults.TcInfo syntaxTree |> GraphNode + + let tcInfoExtras = getTcInfoExtras typeCheckNode + + let diags = + node { + let! _, _, _, _, diags = typeCheckNode.GetOrComputeValue() + return diags + } |> GraphNode + + let startComputingExtras = + node { + let! _ = tcInfoExtras.GetOrComputeValue() + return! diags.GetOrComputeValue() + } + + let tcInfo = + node { + let! prevTcInfo = priorCheckresults.TcInfo.GetOrComputeValue() + match! skippedImplemetationTypeCheck prevTcInfo syntaxTree with + | Some tcInfo -> return tcInfo + | _ -> + let! tcInfo , _, _, _, _ = typeCheckNode.GetOrComputeValue() + // typeCheckNode holds type check results, which can be big. + // We want it to get garbage collected soon, that's why we also start computing extras in parallel here. + // Once this is computed, the intermediate type check results can be freed from memory. + startComputingExtras |> Async.AwaitNodeCode |> Async.Ignore |> Async.Start + return tcInfo + } |> GraphNode + + PartialCheckResults(tcInfo, diags, tcInfoExtras, timeStamp, tcConfig, tcGlobals, tcImports) /// Global service state type FrameworkImportsCacheKey = FrameworkImportsCacheKey of resolvedpath: string list * assemblyName: string * targetFrameworkDirectories: string list * fsharpBinaries: string * langVersion: decimal @@ -532,40 +528,6 @@ type FrameworkImportsCache(size) = return tcGlobals, frameworkTcImports, nonFrameworkResolutions, unresolved } -/// Represents the interim state of checking an assembly -[] -type PartialCheckResults (boundModel: BoundModel, timeStamp: DateTime, projectTimeStamp: DateTime) = - - member _.TcImports = boundModel.TcImports - - member _.TcGlobals = boundModel.TcGlobals - - member _.TcConfig = boundModel.TcConfig - - member _.TimeStamp = timeStamp - - member _.ProjectTimeStamp = projectTimeStamp - - member _.TryPeekTcInfo() = boundModel.TryPeekTcInfo() - - member _.TryPeekTcInfoWithExtras() = boundModel.TryPeekTcInfoWithExtras() - - member _.GetOrComputeTcInfo() = boundModel.GetOrComputeTcInfo() - - member _.GetOrComputeTcInfoWithExtras() = boundModel.GetOrComputeTcInfoWithExtras() - - member _.GetOrComputeItemKeyStoreIfEnabled() = - node { - let! info = boundModel.GetOrComputeTcInfoExtras() - return info.itemKeyStore - } - - member _.GetOrComputeSemanticClassificationIfEnabled() = - node { - let! info = boundModel.GetOrComputeTcInfoExtras() - return info.semanticClassificationKeyStore - } - [] module Utilities = let TryFindFSharpStringAttribute tcGlobals attribSpec attribs = @@ -614,26 +576,15 @@ module IncrementalBuilderHelpers = // Link all the assemblies together and produce the input typecheck accumulator let CombineImportedAssembliesTask ( - assemblyName, tcConfig: TcConfig, - tcConfigP, - tcGlobals, frameworkTcImports, nonFrameworkResolutions, unresolvedReferences, - dependencyProvider, - loadClosureOpt: LoadClosure option, - basicDependencies, - keepAssemblyContents, - keepAllBackgroundResolutions, - keepAllBackgroundSymbolUses, - enableBackgroundItemKeyStoreAndSemanticClassification, - beforeFileChecked, - fileChecked + dependencyProvider #if !NO_TYPEPROVIDERS ,importsInvalidatedByTypeProvider: Event #endif - ) : NodeCode = + ) = node { let diagnosticsLogger = CompilationDiagnosticLogger("CombineImportedAssembliesTask", tcConfig.diagnosticsOptions) @@ -642,7 +593,7 @@ module IncrementalBuilderHelpers = let! tcImports = node { try - let! tcImports = TcImports.BuildNonFrameworkTcImports(tcConfigP, frameworkTcImports, nonFrameworkResolutions, unresolvedReferences, dependencyProvider) + let! tcImports = TcImports.BuildNonFrameworkTcImports(TcConfigProvider.Constant tcConfig, frameworkTcImports, nonFrameworkResolutions, unresolvedReferences, dependencyProvider) #if !NO_TYPEPROVIDERS tcImports.GetCcusExcludingBase() |> Seq.iter (fun ccu -> // When a CCU reports an invalidation, merge them together and just report a @@ -672,6 +623,12 @@ module IncrementalBuilderHelpers = return frameworkTcImports } + return tcImports, diagnosticsLogger.GetDiagnostics() + } + + let GetInitialTcInfo (tcConfig: TcConfig) assemblyName (loadClosureOpt: LoadClosure option) basicDependencies tcGlobals tcImports diagnostics = + let diagnosticsLogger = CompilationDiagnosticLogger("InitialTcInfoTask", tcConfig.diagnosticsOptions) + use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.Parameter) let tcInitial, openDecls0 = GetInitialTcEnv (assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) let tcState = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, tcInitial, openDecls0) let loadClosureErrors = @@ -681,55 +638,39 @@ module IncrementalBuilderHelpers = for inp in loadClosure.Inputs do yield! inp.MetaCommandDiagnostics ] - let initialErrors = Array.append (Array.ofList loadClosureErrors) (diagnosticsLogger.GetDiagnostics()) + let initialErrors = [| yield! loadClosureErrors; yield! diagnosticsLogger.GetDiagnostics(); yield! diagnostics |] let tcInfo = { - tcState=tcState - tcEnvAtEndOfFile=tcInitial - topAttribs=None - latestCcuSigForFile=None + tcState = tcState + tcEnvAtEndOfFile = tcInitial + topAttribs = None + latestCcuSigForFile = None tcDiagnosticsRev = [ initialErrors ] moduleNamesDict = Map.empty tcDependencyFiles = basicDependencies sigNameOpt = None } - return - BoundModel.Create( - tcConfig, - tcGlobals, - tcImports, - keepAssemblyContents, - keepAllBackgroundResolutions, - keepAllBackgroundSymbolUses, - enableBackgroundItemKeyStoreAndSemanticClassification, - beforeFileChecked, - fileChecked, - tcInfo, - None - ) - } + tcInfo /// 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) = + let FinalizeTypeCheckTask (tcConfig: TcConfig) tcGlobals partialCheck assemblyName outfile (initialCheckResults: PartialCheckResults) (partialCheckResults: PartialCheckResults seq) = node { let diagnosticsLogger = CompilationDiagnosticLogger("FinalizeTypeCheckTask", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.TypeCheck) - let! computedBoundModels = boundModels |> Seq.map (fun g -> g.GetOrComputeValue()) |> NodeCode.Sequential - let! tcInfos = - computedBoundModels - |> Seq.map (fun boundModel -> node { return! boundModel.GetOrComputeTcInfo() }) + partialCheckResults + |> Seq.map (fun result -> node { return! result.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 { + partialCheckResults + |> Seq.map (fun result -> node { if partialCheck then return None else - let! tcInfoExtras = boundModel.GetOrComputeTcInfoExtras() + let! tcInfoExtras = result.GetOrComputeTcInfoExtras() return tcInfoExtras.latestImplFile }) |> NodeCode.Parallel @@ -795,18 +736,22 @@ 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 + let finalCheckResult = Seq.last partialCheckResults + let! diags = + [ initialCheckResults; yield! partialCheckResults ] + |> Seq.map (fun result -> result.Diags.GetOrComputeValue()) + |> NodeCode.Sequential + let diagnostics = [ diagnosticsLogger.GetDiagnostics(); yield! diags |> Array.rev ] + let! finalTcInfo = finalCheckResult.TcInfo.GetOrComputeValue() + let finalBoundModelWithErrors = finalCheckResult.Finalize { finalTcInfo with tcDiagnosticsRev = diagnostics; topAttribs = Some topAttrs } + return finalBoundModelWithErrors, ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt } [] type IncrementalBuilderInitialState = { - initialBoundModel: BoundModel tcGlobals: TcGlobals - referencedAssemblies: ImmutableArray * (TimeStampCache -> DateTime)> + referencedAssemblies: (Choice * (TimeStampCache -> DateTime)) list tcConfig: TcConfig outfile: string assemblyName: string @@ -829,7 +774,6 @@ type IncrementalBuilderInitialState = static member Create ( - initialBoundModel: BoundModel, tcGlobals, nonFrameworkAssemblyInputs, tcConfig: TcConfig, @@ -844,16 +788,15 @@ type IncrementalBuilderInitialState = importsInvalidatedByTypeProvider: Event, #endif allDependencies, - defaultTimeStamp: DateTime, + defaultTimeStamp, useChangeNotifications: bool, useSyntaxTreeCache ) = let initialState = { - initialBoundModel = initialBoundModel tcGlobals = tcGlobals - referencedAssemblies = nonFrameworkAssemblyInputs |> ImmutableArray.ofSeq + referencedAssemblies = nonFrameworkAssemblyInputs |> List.ofSeq tcConfig = tcConfig outfile = outfile assemblyName = assemblyName @@ -878,122 +821,77 @@ type IncrementalBuilderInitialState = #endif initialState -// 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 = +type BoundModel = { - HasSignature: bool Stamp: DateTime - LogicalStamp: DateTime SyntaxTree: SyntaxTree - Notified: bool - BoundModel: GraphNode + PartialCheckResults: PartialCheckResults } + member this.FileName = this.SyntaxTree.FileName + member this.HasSignature = this.SyntaxTree.HasSignature member this.Notify timeStamp = - if this.Stamp <> timeStamp then { this with Stamp = timeStamp; Notified = true } else this + if this.Stamp <> timeStamp then { this with Stamp = timeStamp } else this + member this.Notified = this.Stamp <> this.SyntaxTree.TimeStamp [] type IncrementalBuilderState = { - slots: Slot list - stampedReferencedAssemblies: ImmutableArray - initialBoundModel: GraphNode - finalizedBoundModel: GraphNode<(ILAssemblyRef * ProjectAssemblyDataResult * CheckedImplFile list option * BoundModel) * DateTime> + boundModels: BoundModel list + stampedReferencedAssemblies: DateTime list + initialCheckResults: PartialCheckResults + partialCheckResultsBuilder: PartialCheckResultsBuilder + finalizedCheckResults: GraphNode<(PartialCheckResults * ILAssemblyRef * ProjectAssemblyDataResult * CheckedImplFile list option)> } - 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.BoundModel) [] module IncrementalBuilderStateHelpers = // Used to thread the status of the build in computeStampedFileNames mapFold. - type BuildStatus = Invalidated | Good - - let createBoundModelGraphNode (prevBoundModel: GraphNode) syntaxTree = - GraphNode(node { - let! prevBoundModel = prevBoundModel.GetOrComputeValue() - return! prevBoundModel.Next(syntaxTree) - }) + type private BuildStatus = Invalidated | Good - let createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: GraphNode seq) = + let createFinalizeCheckResultsGraphNode (initialState: IncrementalBuilderInitialState) initialErrors (partialCheckResults: PartialCheckResults seq) = GraphNode(node { use _ = Activity.start "GetCheckResultsAndImplementationsForProject" [|Activity.Tags.project, initialState.outfile|] - let! result = + return! FinalizeTypeCheckTask initialState.tcConfig initialState.tcGlobals initialState.enablePartialTypeChecking initialState.assemblyName - initialState.outfile - boundModels - return result, DateTime.UtcNow + initialState.outfile + initialErrors + partialCheckResults }) - let computeStampedFileNames (initialState: IncrementalBuilderInitialState) (state: IncrementalBuilderState) (cache: TimeStampCache) = - let slots = - if initialState.useChangeNotifications then - state.slots - else - [ for slot in state.slots -> cache.GetFileTimeStamp slot.SyntaxTree.FileName |> slot.Notify ] + let checkResultsForFile (builder: PartialCheckResultsBuilder) prevCheckResults syntaxTree = + builder.Next(prevCheckResults, syntaxTree) - 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) - - 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 - | _ -> noChange - - 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 - - let computeStampedReferencedAssemblies (initialState: IncrementalBuilderInitialState) state canTriggerInvalidation (cache: TimeStampCache) = - let stampedReferencedAssemblies = state.stampedReferencedAssemblies.ToBuilder() + let computeStampedFileNames (initialState: IncrementalBuilderInitialState) (state: IncrementalBuilderState) = + let folder (priorCheckResults: PartialCheckResults) (bm: BoundModel) = + let syntaxTree = if bm.Notified then bm.SyntaxTree.Invalidate(bm.Stamp) else bm.SyntaxTree + let partialCheckResults = + if bm.Notified || priorCheckResults.TimeStamp > bm.PartialCheckResults.TimeStamp then + checkResultsForFile state.partialCheckResultsBuilder priorCheckResults syntaxTree + else + bm.PartialCheckResults + let updated = + { bm with + SyntaxTree = syntaxTree + PartialCheckResults = partialCheckResults } - let mutable referencesUpdated = false - initialState.referencedAssemblies - |> ImmutableArray.iteri (fun i asmInfo -> + updated, partialCheckResults - let currentStamp = state.stampedReferencedAssemblies[i] - let stamp = StampReferencedAssemblyTask cache asmInfo + let slots, _ = state.boundModels |> List.mapFold folder state.initialCheckResults + let partialCheckResults = slots |> Seq.map (fun s -> s.PartialCheckResults) + { state with + boundModels = slots + finalizedCheckResults = createFinalizeCheckResultsGraphNode initialState state.initialCheckResults partialCheckResults } - if currentStamp <> stamp then - referencesUpdated <- true - stampedReferencedAssemblies[i] <- stamp - ) + let computeStampedReferencedAssemblies referencedAssemblies (cache: TimeStampCache) = + [ for asmInfo in referencedAssemblies -> StampReferencedAssemblyTask cache asmInfo ] - if referencesUpdated then - // Build is invalidated. The build must be rebuilt with the newly updated references. - if not initialState.isImportsInvalidated && canTriggerInvalidation then - initialState.isImportsInvalidated <- true - { state with - stampedReferencedAssemblies = stampedReferencedAssemblies.ToImmutable() - } - else - state + let checkFileStamps (state: IncrementalBuilderState) (cache: TimeStampCache) = + { state with boundModels = [ for slot in state.boundModels -> cache.GetFileTimeStamp slot.FileName |> slot.Notify ] } type IncrementalBuilderState with @@ -1002,63 +900,45 @@ type IncrementalBuilderState with ReferencedAssembliesStamps => FileStamps => BoundModels => FinalizedBoundModel *) - static member Create(initialState: IncrementalBuilderInitialState) = - let defaultTimeStamp = initialState.defaultTimeStamp - 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 - ] - + static member Create(initialState: IncrementalBuilderInitialState, partialCheckResultsBuilder, initialCheckResults, cache) = let syntaxTrees = [ - for sourceFile, hasSignature in Seq.zip initialState.fileNames hasSignature -> - SyntaxTree(initialState.tcConfig, initialState.fileParsed, initialState.lexResourceManager, sourceFile, hasSignature) + for sourceFile in initialState.fileNames -> + SyntaxTree(initialState.tcConfig, initialState.fileParsed, initialState.lexResourceManager, sourceFile, DateTime.MinValue) ] - let boundModels = + let partialCheckResults = syntaxTrees - |> Seq.scan createBoundModelGraphNode initialBoundModel + |> Seq.scan (checkResultsForFile partialCheckResultsBuilder) initialCheckResults |> Seq.skip 1 let slots = [ - for model, syntaxTree, hasSignature in Seq.zip3 boundModels syntaxTrees hasSignature do + for results, syntaxTree in Seq.zip partialCheckResults syntaxTrees do { - HasSignature = hasSignature Stamp = DateTime.MinValue - LogicalStamp = DateTime.MinValue - Notified = false SyntaxTree = syntaxTree - BoundModel = model + PartialCheckResults = results } ] + let stampedReferencedAssemblies = computeStampedReferencedAssemblies initialState.referencedAssemblies cache + let state = { - slots = slots - stampedReferencedAssemblies = ImmutableArray.init referencedAssemblies.Length (fun _ -> DateTime.MinValue) - initialBoundModel = initialBoundModel - finalizedBoundModel = createFinalizeBoundModelGraphNode initialState boundModels + boundModels = slots + stampedReferencedAssemblies = stampedReferencedAssemblies + partialCheckResultsBuilder = partialCheckResultsBuilder + initialCheckResults = initialCheckResults + finalizedCheckResults = createFinalizeCheckResultsGraphNode initialState initialCheckResults partialCheckResults } - let state = computeStampedReferencedAssemblies initialState state false cache - let state = computeStampedFileNames initialState state cache + let state = if initialState.useChangeNotifications then state else checkFileStamps state cache + let state = computeStampedFileNames initialState state state /// Manages an incremental build graph for the build of a single F# project type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: IncrementalBuilderState) = - let initialBoundModel = initialState.initialBoundModel let tcConfig = initialState.tcConfig let fileNames = initialState.fileNames let beforeFileChecked = initialState.beforeFileChecked @@ -1066,74 +946,36 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc #if !NO_TYPEPROVIDERS let importsInvalidatedByTypeProvider = initialState.importsInvalidatedByTypeProvider #endif - let allDependencies = initialState.allDependencies let defaultTimeStamp = initialState.defaultTimeStamp let fileParsed = initialState.fileParsed let projectChecked = initialState.projectChecked - let tryGetSlot (state: IncrementalBuilderState) slot = - match state.boundModels[slot].TryPeekValue() with - | ValueSome boundModel -> - (boundModel, state.stampedFileNames[slot]) - |> Some - | _ -> - None - - let tryGetBeforeSlot (state: IncrementalBuilderState) slot = - match slot with - | 0 (* first file *) -> - (initialBoundModel, defaultTimeStamp) - |> Some - | _ -> - tryGetSlot state (slot - 1) - - let evalUpToTargetSlot (state: IncrementalBuilderState) targetSlot = - node { - if targetSlot < 0 then - return Some(initialBoundModel, defaultTimeStamp) - else - let! boundModel = state.boundModels[targetSlot].GetOrComputeValue() - return Some(boundModel, state.stampedFileNames[targetSlot]) - } - - let MaxTimeStampInDependencies stamps fileSlot = - if Seq.isEmpty stamps then - defaultTimeStamp + let getSlot (state: IncrementalBuilderState) slot = + if slot = -1 then + state.initialCheckResults else - let stamps = - match fileSlot with - | -1 -> stamps - | fileSlot -> stamps |> Seq.take fileSlot + state.boundModels[slot].PartialCheckResults - stamps |> Seq.max + let getBeforeSlot (state: IncrementalBuilderState) slot = + getSlot state (slot - 1) - let computeProjectTimeStamp (state: IncrementalBuilderState) fileSlot = - if fileSlot = 0 then - MaxTimeStampInDependencies state.stampedReferencedAssemblies -1 - else - let t1 = MaxTimeStampInDependencies state.stampedReferencedAssemblies -1 - let t2 = MaxTimeStampInDependencies state.logicalStampedFileNames fileSlot - max t1 t2 + let mutable currentState = state - let semaphore = new SemaphoreSlim(1,1) + let guard = obj() - let mutable currentState = state + let setCurrentState state = + lock guard <| fun () -> + currentState <- computeStampedFileNames initialState state - let setCurrentState state cache (ct: CancellationToken) = - node { - do! semaphore.WaitAsync(ct) |> NodeCode.AwaitTask - try - ct.ThrowIfCancellationRequested() - currentState <- computeStampedFileNames initialState state cache - finally - semaphore.Release() |> ignore - } + let checkFileTimeStampsIfNotUsingNotifications cache = + if not initialState.useChangeNotifications then + checkFileStamps currentState cache + |> setCurrentState - let checkFileTimeStamps (cache: TimeStampCache) = - node { - let! ct = NodeCode.CancellationToken - do! setCurrentState currentState cache ct - } + let updateFileTimeStampsIfNotUsingNotifications () = + if not initialState.useChangeNotifications then + let cache = TimeStampCache defaultTimeStamp + checkFileTimeStampsIfNotUsingNotifications cache do IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBECreated) @@ -1154,77 +996,38 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc member _.IsReferencesInvalidated = // fast path if initialState.isImportsInvalidated then true - else - computeStampedReferencedAssemblies initialState currentState true (TimeStampCache(defaultTimeStamp)) |> ignore - initialState.isImportsInvalidated - - member _.AllDependenciesDeprecated = allDependencies + else + let stampedReferencedAssemblies = + computeStampedReferencedAssemblies initialState.referencedAssemblies (TimeStampCache defaultTimeStamp) + state.stampedReferencedAssemblies <> stampedReferencedAssemblies - member _.PopulatePartialCheckingResults () = - node { - let cache = TimeStampCache defaultTimeStamp // One per step - do! checkFileTimeStamps cache - let! _ = currentState.finalizedBoundModel.GetOrComputeValue() - projectChecked.Trigger() - } + member _.AllDependenciesDeprecated = initialState.allDependencies - member builder.GetCheckResultsBeforeFileInProjectEvenIfStale fileName: PartialCheckResults option = + member builder.GetCheckResultsBeforeFileInProjectEvenIfStale fileName = + updateFileTimeStampsIfNotUsingNotifications () let slotOfFile = builder.GetSlotOfFileName fileName - let result = tryGetBeforeSlot currentState slotOfFile - - match result with - | Some (boundModel, timestamp) -> - let projectTimeStamp = builder.GetLogicalTimeStampForFileInProject(fileName) - Some (PartialCheckResults (boundModel, timestamp, projectTimeStamp)) - | _ -> None + getBeforeSlot currentState slotOfFile - member builder.GetCheckResultsForFileInProjectEvenIfStale fileName: PartialCheckResults option = + member builder.GetCheckResultsForFileInProjectEvenIfStale fileName = + updateFileTimeStampsIfNotUsingNotifications () let slotOfFile = builder.GetSlotOfFileName fileName - let result = tryGetSlot currentState slotOfFile - - match result with - | Some (boundModel, timestamp) -> - let projectTimeStamp = builder.GetLogicalTimeStampForFileInProject(fileName) - Some (PartialCheckResults (boundModel, timestamp, projectTimeStamp)) - | _ -> None + getSlot currentState slotOfFile member builder.TryGetCheckResultsBeforeFileInProject fileName = - let cache = TimeStampCache defaultTimeStamp - let tmpState = computeStampedFileNames initialState currentState cache - + updateFileTimeStampsIfNotUsingNotifications () let slotOfFile = builder.GetSlotOfFileName fileName - match tryGetBeforeSlot tmpState slotOfFile with - | Some(boundModel, timestamp) -> - let projectTimeStamp = builder.GetLogicalTimeStampForFileInProject(fileName) - Some (PartialCheckResults (boundModel, timestamp, projectTimeStamp)) - | _ -> None + getBeforeSlot currentState slotOfFile - member builder.AreCheckResultsBeforeFileInProjectReady fileName = - (builder.TryGetCheckResultsBeforeFileInProject fileName).IsSome - - member builder.GetCheckResultsBeforeSlotInProject slotOfFile = - node { - let cache = TimeStampCache defaultTimeStamp - do! checkFileTimeStamps cache - let! result = evalUpToTargetSlot currentState (slotOfFile - 1) - match result with - | Some (boundModel, timestamp) -> - let projectTimeStamp = builder.GetLogicalTimeStampForFileInProject(slotOfFile) - return PartialCheckResults(boundModel, timestamp, projectTimeStamp) - | None -> return! failwith "Expected results to be ready. (GetCheckResultsBeforeSlotInProject)." - } + member _.GetCheckResultsBeforeSlotInProject slotOfFile = + updateFileTimeStampsIfNotUsingNotifications () + getBeforeSlot currentState slotOfFile member builder.GetFullCheckResultsBeforeSlotInProject slotOfFile = node { - let cache = TimeStampCache defaultTimeStamp - do! checkFileTimeStamps cache - let! result = evalUpToTargetSlot currentState (slotOfFile - 1) - match result with - | Some (boundModel, timestamp) -> - let! _ = boundModel.GetOrComputeTcInfoExtras() - let projectTimeStamp = builder.GetLogicalTimeStampForFileInProject(slotOfFile) - return PartialCheckResults(boundModel, timestamp, projectTimeStamp) - | None -> return! failwith "Expected results to be ready. (GetFullCheckResultsBeforeSlotInProject)." + updateFileTimeStampsIfNotUsingNotifications () + let results = getBeforeSlot currentState slotOfFile + let! _ = results.GetOrComputeTcInfoExtras() + return results } member builder.GetCheckResultsBeforeFileInProject fileName = @@ -1249,17 +1052,11 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc member builder.GetCheckResultsAfterLastFileInProject () = builder.GetCheckResultsBeforeSlotInProject(builder.GetSlotsCount()) - member builder.GetCheckResultsAndImplementationsForProject() = - node { - let cache = TimeStampCache(defaultTimeStamp) - do! checkFileTimeStamps cache - let! result = currentState.finalizedBoundModel.GetOrComputeValue() - match result with - | (ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt, boundModel), timestamp -> - let cache = TimeStampCache defaultTimeStamp - let projectTimeStamp = builder.GetLogicalTimeStampForProject(cache) - return PartialCheckResults (boundModel, timestamp, projectTimeStamp), ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt - } + member _.GetCheckResultsAndImplementationsForProject() = + node { + updateFileTimeStampsIfNotUsingNotifications () + return! currentState.finalizedCheckResults.GetOrComputeValue() + } member builder.GetFullCheckResultsAndImplementationsForProject() = node { @@ -1269,25 +1066,17 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc return result } - member builder.GetLogicalTimeStampForFileInProject(filename: string) = - let slot = builder.GetSlotOfFileName(filename) - builder.GetLogicalTimeStampForFileInProject(slot) - - member _.GetLogicalTimeStampForFileInProject(slotOfFile: int) = - let cache = TimeStampCache defaultTimeStamp - let tempState = computeStampedFileNames initialState currentState cache - computeProjectTimeStamp tempState slotOfFile - member _.GetLogicalTimeStampForProject(cache) = - let tempState = computeStampedFileNames initialState currentState cache - computeProjectTimeStamp tempState -1 + checkFileTimeStampsIfNotUsingNotifications cache + let slot = currentState.boundModels |> List.last + slot.PartialCheckResults.TimeStamp member _.TryGetSlotOfFileName(fileName: string) = - // Get the slot of the given file and force it to build. + // Get the slot of the given file. let CompareFileNames f = let result = - String.Compare(fileName, f.Source.FilePath, StringComparison.CurrentCultureIgnoreCase)=0 - || String.Compare(FileSystem.GetFullPathShim fileName, FileSystem.GetFullPathShim f.Source.FilePath, StringComparison.CurrentCultureIgnoreCase)=0 + String.Compare(fileName, f.Name, StringComparison.CurrentCultureIgnoreCase)=0 + || String.Compare(FileSystem.GetFullPathShim fileName, FileSystem.GetFullPathShim f.Name, StringComparison.CurrentCultureIgnoreCase)=0 result match fileNames |> List.tryFindIndex CompareFileNames with | Some slot -> Some slot @@ -1305,23 +1094,18 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc member builder.GetParseResultsForFile fileName = let slotOfFile = builder.GetSlotOfFileName fileName - let syntaxTree = currentState.slots[slotOfFile].SyntaxTree + let syntaxTree = currentState.boundModels[slotOfFile].SyntaxTree syntaxTree.ParseNode.GetOrComputeValue() |> Async.AwaitNodeCode |> Async.RunSynchronously member builder.NotifyFileChanged(fileName, timeStamp) = - node { - let slotOfFile = builder.GetSlotOfFileName fileName - let cache = TimeStampCache defaultTimeStamp - let! ct = NodeCode.CancellationToken - do! setCurrentState - { currentState with - slots = currentState.slots |> List.updateAt slotOfFile (currentState.slots[slotOfFile].Notify timeStamp) } - cache ct - } + let slotOfFile = builder.GetSlotOfFileName fileName + setCurrentState + { currentState with + boundModels = currentState.boundModels |> List.updateAt slotOfFile (currentState.boundModels[slotOfFile].Notify timeStamp) } - member _.SourceFiles = fileNames |> Seq.map (fun f -> f.Source.FilePath) |> List.ofSeq + member _.SourceFiles = fileNames |> Seq.map (fun f -> f.Name) |> List.ofSeq /// CreateIncrementalBuilder (for background type checking). Note that fsc.fs also /// creates an incremental builder used by the command line compiler. @@ -1492,7 +1276,6 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc // Start importing - let tcConfigP = TcConfigProvider.Constant tcConfig let beforeFileChecked = Event() let fileChecked = Event() @@ -1516,7 +1299,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc yield file for r in nonFrameworkResolutions do - yield r.resolvedPath ] + yield r.resolvedPath ] let allDependencies = [| yield! basicDependencies @@ -1531,30 +1314,40 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc | Some dependencyProvider -> dependencyProvider let defaultTimeStamp = DateTime.UtcNow + let cache = TimeStampCache defaultTimeStamp - let! initialBoundModel = + let! tcImports, diagnostics = CombineImportedAssembliesTask( - assemblyName, tcConfig, - tcConfigP, - tcGlobals, frameworkTcImports, nonFrameworkResolutions, unresolvedReferences, - dependencyProvider, - loadClosureOpt, - basicDependencies, + dependencyProvider +#if !NO_TYPEPROVIDERS + ,importsInvalidatedByTypeProvider +#endif + ) + + let partialCheckResultsBuilder = + PartialCheckResultsBuilder( + tcImports, + tcConfig, + tcGlobals, + enableBackgroundItemKeyStoreAndSemanticClassification, keepAssemblyContents, keepAllBackgroundResolutions, keepAllBackgroundSymbolUses, - enableBackgroundItemKeyStoreAndSemanticClassification, beforeFileChecked, - fileChecked -#if !NO_TYPEPROVIDERS - ,importsInvalidatedByTypeProvider -#endif + fileChecked ) + let tcInfo = GetInitialTcInfo tcConfig assemblyName loadClosureOpt basicDependencies tcGlobals tcImports diagnostics + let defaultTcInfoExtras = partialCheckResultsBuilder.DefaultTcInfoExtras(tcInfo) + + let initialCheckResults = + let diags = tcInfo.TcDiagnostics + partialCheckResultsBuilder.Create(GraphNode.FromResult tcInfo, GraphNode.FromResult diags, defaultTcInfoExtras, defaultTimeStamp) + let getFSharpSource fileName = getSource |> Option.map(fun getSource -> @@ -1564,14 +1357,25 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc FSharpSource.Create(fileName, getTimeStamp, getSourceText)) |> Option.defaultWith(fun () -> FSharpSource.CreateFromFile(fileName)) + 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 + let fileNames = sourceFiles |> List.map (fun (_, fileName, _) -> fileName ) + [ + false + for prev, file in fileNames |> List.pairwise do + isBackingSignature file prev + ] + let sourceFiles = - sourceFiles - |> List.map (fun (m, fileName, isLastCompiland) -> - { Range = m; Source = getFSharpSource fileName; Flags = isLastCompiland } ) + [ for (m, fileName, isLastCompiland), hasSignature in List.zip sourceFiles hasSignature -> + { Name = fileName; HasSignature = hasSignature; Range = m; Source = getFSharpSource fileName; Flags = isLastCompiland } ] let initialState = IncrementalBuilderInitialState.Create( - initialBoundModel, tcGlobals, nonFrameworkAssemblyInputs, tcConfig, @@ -1591,7 +1395,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc useSyntaxTreeCache ) - let builder = IncrementalBuilder(initialState, IncrementalBuilderState.Create(initialState)) + let builder = IncrementalBuilder(initialState, IncrementalBuilderState.Create(initialState, partialCheckResultsBuilder, initialCheckResults, cache)) return Some builder with exn -> errorRecoveryNoRange exn diff --git a/src/Compiler/Service/IncrementalBuild.fsi b/src/Compiler/Service/IncrementalBuild.fsi index b4e60d403f0..d64701f9e02 100644 --- a/src/Compiler/Service/IncrementalBuild.fsi +++ b/src/Compiler/Service/IncrementalBuild.fsi @@ -102,8 +102,6 @@ type internal PartialCheckResults = member TimeStamp: DateTime - member ProjectTimeStamp: DateTime - member TryPeekTcInfo: unit -> TcInfo option member TryPeekTcInfoWithExtras: unit -> (TcInfo * TcInfoExtras) option @@ -130,8 +128,6 @@ type internal PartialCheckResults = /// Will return 'None' for enableBackgroundItemKeyStoreAndSemanticClassification=false. member GetOrComputeSemanticClassificationIfEnabled: unit -> NodeCode - member TimeStamp: DateTime - /// Manages an incremental build graph for the build of an F# project [] type internal IncrementalBuilder = @@ -168,42 +164,30 @@ type internal IncrementalBuilder = /// The list of files the build depends on member AllDependenciesDeprecated: string[] - /// The project build. Return true if the background work is finished. - member PopulatePartialCheckingResults: unit -> NodeCode - /// Get the preceding typecheck state of a slot, without checking if it is up-to-date w.r.t. /// the timestamps on files and referenced DLLs prior to this one. Return None if the result is not available. /// This is a very quick operation. /// /// This is safe for use from non-compiler threads but the objects returned must in many cases be accessed only from the compiler thread. - member GetCheckResultsBeforeFileInProjectEvenIfStale: fileName: string -> PartialCheckResults option + member GetCheckResultsBeforeFileInProjectEvenIfStale: fileName: string -> PartialCheckResults /// Get the typecheck state of a slot, without checking if it is up-to-date w.r.t. /// the timestamps on files and referenced DLLs prior to this one. Return None if the result is not available. /// This is a very quick operation. /// /// This is safe for use from non-compiler threads but the objects returned must in many cases be accessed only from the compiler thread. - member GetCheckResultsForFileInProjectEvenIfStale: fileName: string -> PartialCheckResults option - - // TODO: Looks like the following doc does not match the actual method or it's signature. - - /// Get the preceding typecheck state of a slot, but only if it is up-to-date w.r.t. - /// the timestamps on files and referenced DLLs prior to this one. Return None if the result is not available. - /// This is a relatively quick operation. - /// - /// This is safe for use from non-compiler threads - member AreCheckResultsBeforeFileInProjectReady: fileName: string -> bool + member GetCheckResultsForFileInProjectEvenIfStale: fileName: string -> PartialCheckResults /// Get the preceding typecheck state of a slot, WITH checking if it is up-to-date w.r.t. the timestamps of files and referenced DLLs prior to this one. /// However, files will not be parsed or checked. /// Return None if the result is not available or if it is not up-to-date. /// /// This is safe for use from non-compiler threads but the objects returned must in many cases be accessed only from the compiler thread. - member TryGetCheckResultsBeforeFileInProject: fileName: string -> PartialCheckResults option + member TryGetCheckResultsBeforeFileInProject: fileName: string -> PartialCheckResults /// Get the preceding typecheck state of a slot. Compute the entire type check of the project up /// to the necessary point if the result is not available. This may be a long-running operation. - member GetCheckResultsBeforeFileInProject: fileName: string -> NodeCode + member GetCheckResultsBeforeFileInProject: fileName: string -> PartialCheckResults /// Get the preceding typecheck state of a slot. Compute the entire type check of the project up /// to the necessary point if the result is not available. This may be a long-running operation. @@ -212,7 +196,7 @@ type internal IncrementalBuilder = /// Get the typecheck state after checking a file. Compute the entire type check of the project up /// to the necessary point if the result is not available. This may be a long-running operation. - member GetCheckResultsAfterFileInProject: fileName: string -> NodeCode + member GetCheckResultsAfterFileInProject: fileName: string -> PartialCheckResults /// Get the typecheck state after checking a file. Compute the entire type check of the project up /// to the necessary point if the result is not available. This may be a long-running operation. @@ -221,7 +205,7 @@ type internal IncrementalBuilder = /// Get the typecheck result after the end of the last file. The typecheck of the project is not 'completed'. /// This may be a long-running operation. - member GetCheckResultsAfterLastFileInProject: unit -> NodeCode + member GetCheckResultsAfterLastFileInProject: unit -> PartialCheckResults /// Get the final typecheck result. If 'generateTypedImplFiles' was set on Create then the CheckedAssemblyAfterOptimization will contain implementations. /// This may be a long-running operation. @@ -248,7 +232,7 @@ type internal IncrementalBuilder = member GetParseResultsForFile: fileName: string -> ParsedInput * range * string * (PhasedDiagnostic * FSharpDiagnosticSeverity)[] - member NotifyFileChanged: fileName: string * timeStamp: DateTime -> NodeCode + member NotifyFileChanged: fileName: string * timeStamp: DateTime -> unit /// Create the incremental builder static member TryCreateIncrementalBuilderForProjectOptions: diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index ae56b28acb2..44303c5b255 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -581,11 +581,7 @@ type BackgroundCompiler | Some cachedResults -> match! cachedResults.GetOrComputeValue() with | parseResults, checkResults, _, priorTimeStamp when - (match builder.GetCheckResultsBeforeFileInProjectEvenIfStale fileName with - | None -> false - | Some (tcPrior) -> - tcPrior.ProjectTimeStamp = priorTimeStamp - && builder.AreCheckResultsBeforeFileInProjectReady(fileName)) + (builder.GetCheckResultsBeforeFileInProjectEvenIfStale fileName).TimeStamp = priorTimeStamp -> return Some(parseResults, checkResults) | _ -> @@ -637,7 +633,7 @@ type BackgroundCompiler |> NodeCode.FromCancellable GraphNode.SetPreferredUILang tcConfig.preferredUiLang - return (parseResults, checkAnswer, sourceText.GetHashCode() |> int64, tcPrior.ProjectTimeStamp) + return (parseResults, checkAnswer, sourceText.GetHashCode() |> int64, tcPrior.TimeStamp) } member private bc.CheckOneFileImpl @@ -702,16 +698,15 @@ type BackgroundCompiler | Some (builder, creationDiags, None) -> Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "CheckFileInProjectAllowingStaleCachedResults.CacheMiss", fileName) - match builder.GetCheckResultsBeforeFileInProjectEvenIfStale fileName with - | Some tcPrior -> - match tcPrior.TryPeekTcInfo() with - | Some tcInfo -> - let! checkResults = - bc.CheckOneFileImpl(parseResults, sourceText, fileName, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) + let tcPrior = builder.GetCheckResultsBeforeFileInProjectEvenIfStale fileName - return Some checkResults - | None -> return None - | None -> return None // the incremental builder was not up to date + match tcPrior.TryPeekTcInfo() with + | Some tcInfo -> + let! checkResults = + bc.CheckOneFileImpl(parseResults, sourceText, fileName, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) + + return Some checkResults + | None -> return None } /// Type-check the result obtained by parsing. Force the evaluation of the antecedent type checking context if needed. @@ -737,7 +732,7 @@ type BackgroundCompiler match cachedResults with | Some (_, checkResults) -> return FSharpCheckFileAnswer.Succeeded checkResults | _ -> - let! tcPrior = builder.GetCheckResultsBeforeFileInProject fileName + let tcPrior = builder.GetCheckResultsBeforeFileInProject fileName let! tcInfo = tcPrior.GetOrComputeTcInfo() return! bc.CheckOneFileImpl(parseResults, sourceText, fileName, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) } @@ -768,7 +763,7 @@ type BackgroundCompiler match cachedResults with | Some (parseResults, checkResults) -> return (parseResults, FSharpCheckFileAnswer.Succeeded checkResults) | _ -> - let! tcPrior = builder.GetCheckResultsBeforeFileInProject fileName + let tcPrior = builder.GetCheckResultsBeforeFileInProject fileName let! tcInfo = tcPrior.GetOrComputeTcInfo() // Do the parsing. let parsingOptions = @@ -811,7 +806,7 @@ type BackgroundCompiler match builderOpt with | None -> return () - | Some builder -> do! builder.NotifyFileChanged(fileName, DateTime.UtcNow) + | Some builder -> builder.NotifyFileChanged(fileName, DateTime.UtcNow) } /// Fetch the check information from the background compiler (which checks w.r.t. the FileSystem API) diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 82efbccafab..f094c2e6e04 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -250,6 +250,7 @@ + diff --git a/tests/FSharp.Compiler.ComponentTests/Signatures/MissingDiagnostic.fs b/tests/FSharp.Compiler.ComponentTests/Signatures/MissingDiagnostic.fs new file mode 100644 index 00000000000..2d263fa728f --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Signatures/MissingDiagnostic.fs @@ -0,0 +1,54 @@ +module FSharp.Compiler.ComponentTests.Signatures.MissingDiagnostic + +open Xunit +open FSharp.Test +open FSharp.Test.Compiler + +let implementation = """ +module Foo + +let a (b: int) : int = 'x' +""" + +let signature = """ +module Foo + +val a: b: int -> int +""" + +[] +let ``Compile gives errors`` () = + Fsi signature + |> withAdditionalSourceFile (FsSource implementation) + |> compile + |> shouldFail + |> withSingleDiagnostic (Error 1, Line 4, Col 24, Line 4,Col 27, "This expression was expected to have type + 'int' +but here has type + 'char' ") + +[] +let ``Type check project with signature file doesn't get the diagnostic`` () = + Fsi signature + |> withAdditionalSourceFile (FsSource implementation) + |> typecheckProject false + |> fun projectResults -> + projectResults.Diagnostics |> ignore + Assert.False (projectResults.Diagnostics |> Array.isEmpty) + +[] +let ``Type check project without signature file does get the diagnostic`` () = + Fs implementation + |> typecheckProject false + |> fun projectResults -> + projectResults.Diagnostics |> ignore + Assert.False (projectResults.Diagnostics |> Array.isEmpty) + +[] +let ``Enabling enablePartialTypeChecking = true doesn't change the problem`` () = + Fsi signature + |> withAdditionalSourceFile (FsSource implementation) + |> typecheckProject true + |> fun projectResults -> + projectResults.Diagnostics |> ignore + Assert.False (projectResults.Diagnostics |> Array.isEmpty) \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/TyparNameTests.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/TyparNameTests.fs index 8b81bc0a312..2761fb8cfeb 100644 --- a/tests/FSharp.Compiler.ComponentTests/TypeChecks/TyparNameTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/TyparNameTests.fs @@ -12,7 +12,7 @@ let private getGenericParametersNamesFor (additionalFile: SourceCodeFileKind) : string array = let typeCheckResult = - cUnit |> withAdditionalSourceFile additionalFile |> typecheckProject + cUnit |> withAdditionalSourceFile additionalFile |> typecheckProject false assert (Array.isEmpty typeCheckResult.Diagnostics) diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index c8adbc52e6e..caa56ba97e5 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -917,7 +917,7 @@ module rec Compiler = CompilerAssert.TypeCheck(options, fileName, source) | _ -> failwith "Typecheck only supports F#" - let typecheckProject (cUnit: CompilationUnit) : FSharp.Compiler.CodeAnalysis.FSharpCheckProjectResults = + let typecheckProject enablePartialTypeChecking (cUnit: CompilationUnit) : FSharp.Compiler.CodeAnalysis.FSharpCheckProjectResults = match cUnit with | FS fsSource -> let options = fsSource.Options |> Array.ofList @@ -935,7 +935,7 @@ module rec Compiler = |> async.Return let sourceFiles = Array.map fst sourceFiles - CompilerAssert.TypeCheckProject(options, sourceFiles, getSourceText) + CompilerAssert.TypeCheckProject(options, sourceFiles, getSourceText, enablePartialTypeChecking) | _ -> failwith "Typecheck only supports F#" let run (result: CompilationResult) : CompilationResult = diff --git a/tests/FSharp.Test.Utilities/CompilerAssert.fs b/tests/FSharp.Test.Utilities/CompilerAssert.fs index c5ec19006e5..f209beab7d0 100644 --- a/tests/FSharp.Test.Utilities/CompilerAssert.fs +++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs @@ -858,8 +858,8 @@ Updated automatically, please check diffs in your pull request, changes must be static member TypeCheckSingleError (source: string) (expectedSeverity: FSharpDiagnosticSeverity) (expectedErrorNumber: int) (expectedErrorRange: int * int * int * int) (expectedErrorMsg: string) = CompilerAssert.TypeCheckWithErrors source [| expectedSeverity, expectedErrorNumber, expectedErrorRange, expectedErrorMsg |] - static member TypeCheckProject(options: string array, sourceFiles: string array, getSourceText) : FSharpCheckProjectResults = - let checker = FSharpChecker.Create(documentSource = DocumentSource.Custom getSourceText) + static member TypeCheckProject(options: string array, sourceFiles: string array, getSourceText, enablePartialTypeChecking) : FSharpCheckProjectResults = + let checker = FSharpChecker.Create(documentSource = DocumentSource.Custom getSourceText, enablePartialTypeChecking = enablePartialTypeChecking) let defaultOptions = defaultProjectOptions TargetFramework.Current let projectOptions = { defaultOptions with OtherOptions = Array.append options defaultOptions.OtherOptions; SourceFiles = sourceFiles } diff --git a/tests/service/ProjectAnalysisTests.fs b/tests/service/ProjectAnalysisTests.fs index 0ee58b1898f..b734107fff2 100644 --- a/tests/service/ProjectAnalysisTests.fs +++ b/tests/service/ProjectAnalysisTests.fs @@ -5229,6 +5229,7 @@ let ``Test project42 to ensure cached checked results are invalidated`` () = match checkedFile2 with | _, FSharpCheckFileAnswer.Succeeded(checkedFile2Results) -> Assert.IsEmpty(checkedFile2Results.Diagnostics) + Async.Sleep(300) |> Async.RunImmediate FileSystem.OpenFileForWriteShim(Project42.fileName1).Write("""module File1""") try let checkedFile2Again = checker.ParseAndCheckFileInProject(Project42.fileName2, text2.GetHashCode(), text2, Project42.options) |> Async.RunImmediate