diff --git a/eng/Versions.props b/eng/Versions.props index 979442cba5e..c82085d4f81 100644 --- a/eng/Versions.props +++ b/eng/Versions.props @@ -88,6 +88,7 @@ 4.5.1 6.0.0 1.6.0 + 6.0.0 4.5.5 4.7.0 6.0.0 diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 6f428eaa698..a18dd3e30e6 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -5,6 +5,7 @@ module internal FSharp.Compiler.CheckDeclarations open System open System.Collections.Generic +open FSharp.Compiler.Diagnostics open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras @@ -5289,11 +5290,17 @@ let CheckOneImplFile env, rootSigOpt: ModuleOrNamespaceType option, synImplFile) = - - let (ParsedImplFileInput (_, isScript, qualNameOfFile, scopedPragmas, _, implFileFrags, isLastCompiland, _)) = synImplFile + + let (ParsedImplFileInput (fileName, isScript, qualNameOfFile, scopedPragmas, _, implFileFrags, isLastCompiland, _)) = synImplFile let infoReader = InfoReader(g, amap) cancellable { + use _ = + Activity.start "CheckDeclarations.CheckOneImplFile" + [| + "fileName", fileName + "qualifiedNameOfFile", qualNameOfFile.Text + |] let cenv = cenv.Create (g, isScript, amap, thisCcu, false, Option.isSome rootSigOpt, conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g), isInternalTestSpanStackReferring, @@ -5421,6 +5428,12 @@ let CheckOneImplFile /// Check an entire signature file let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSink, isInternalTestSpanStackReferring) tcEnv (sigFile: ParsedSigFileInput) = cancellable { + use _ = + Activity.start "CheckDeclarations.CheckOneSigFile" + [| + "fileName", sigFile.FileName + "qualifiedNameOfFile", sigFile.QualifiedName.Text + |] let cenv = cenv.Create (g, false, amap, thisCcu, true, false, conditionalDefines, tcSink, diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index 82a5df7242b..02c3306b2d9 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -2331,13 +2331,14 @@ let PrintWholeAssemblyImplementation (tcConfig: TcConfig) outfile header expr = //---------------------------------------------------------------------------- let mutable tPrev: (DateTime * DateTime * float * int[]) option = None -let mutable nPrev: string option = None +let mutable nPrev: (string * IDisposable) option = None let ReportTime (tcConfig: TcConfig) descr = - match nPrev with | None -> () - | Some prevDescr -> + | Some (prevDescr, prevActivity) -> + use _ = prevActivity // Finish the previous diagnostics activity by .Dispose() at the end of this block + if tcConfig.pause then dprintf "[done '%s', entering '%s'] press to continue... " prevDescr descr Console.ReadLine() |> ignore @@ -2376,7 +2377,7 @@ let ReportTime (tcConfig: TcConfig) descr = let tStart = match tPrev, nPrev with - | Some (tStart, tPrev, utPrev, gcPrev), Some prevDescr -> + | Some (tStart, tPrev, utPrev, gcPrev), Some (prevDescr, _) -> let spanGC = [| for i in 0..maxGen -> GC.CollectionCount i - gcPrev[i] |] let t = tNow - tStart let tDelta = tNow - tPrev @@ -2403,7 +2404,7 @@ let ReportTime (tcConfig: TcConfig) descr = tPrev <- Some(tStart, tNow, utNow, gcNow) - nPrev <- Some descr + nPrev <- Some(descr, Activity.startNoTags descr) let ignoreFailureOnMono1_1_16 f = try diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index b63976cb7d5..23bd5a2160a 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -4,6 +4,7 @@ module internal FSharp.Compiler.ParseAndCheckInputs open System +open System.Diagnostics open System.IO open System.Collections.Generic @@ -1175,6 +1176,9 @@ let CheckOneInputAux cancellable { try + use _ = + Activity.start "ParseAndCheckInputs.CheckOneInput" [| "fileName", inp.FileName |] + CheckSimulateException tcConfig let m = inp.Range @@ -1365,10 +1369,8 @@ let CheckMultipleInputsFinish (results, tcState: TcState) = let CheckOneInputAndFinish (checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) = cancellable { - Logger.LogBlockStart LogCompilerFunctionId.CompileOps_TypeCheckOneInputAndFinishEventually let! result, tcState = CheckOneInput(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input, false) let finishedResult = CheckMultipleInputsFinish([ result ], tcState) - Logger.LogBlockStop LogCompilerFunctionId.CompileOps_TypeCheckOneInputAndFinishEventually return finishedResult } diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 270f6e948b9..e8ec56fa5a5 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -532,7 +532,6 @@ let main1 // Process command line, flags and collect filenames let sourceFiles = - // The ParseCompilerOptions function calls imperative function to process "real" args // Rather than start processing, just collect names, then process them. try @@ -710,7 +709,6 @@ let main2 exiter: Exiter, ilSourceDocs)) = - if tcConfig.typeCheckOnly then exiter.Exit 0 @@ -818,7 +816,6 @@ let main3 exiter: Exiter, ilSourceDocs)) = - // Encode the signature data ReportTime tcConfig "Encode Interface Data" let exportRemapping = MakeExportRemapping generatedCcu generatedCcu.Contents @@ -914,7 +911,6 @@ let main4 exiter: Exiter, ilSourceDocs)) = - match tcImportsCapture with | None -> () | Some f -> f tcImports @@ -1049,7 +1045,6 @@ let main6 exiter: Exiter, ilSourceDocs)) = - ReportTime tcConfig "Write .NET Binary" use _ = UseBuildPhase BuildPhase.Output diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index eedb771f0f3..a24a675f3b1 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -29,7 +29,7 @@ - false + false @@ -57,6 +57,7 @@ + @@ -91,6 +92,8 @@ FSStrings.resx FSStrings.resources + + @@ -131,8 +134,6 @@ - - @@ -488,6 +489,7 @@ + diff --git a/src/Compiler/FSharp.Compiler.Service.nuspec b/src/Compiler/FSharp.Compiler.Service.nuspec index a60bdb81021..2879d336381 100644 --- a/src/Compiler/FSharp.Compiler.Service.nuspec +++ b/src/Compiler/FSharp.Compiler.Service.nuspec @@ -8,6 +8,7 @@ + diff --git a/src/Compiler/Facilities/BuildGraph.fs b/src/Compiler/Facilities/BuildGraph.fs index 6170d726d75..b8ee50564c1 100644 --- a/src/Compiler/Facilities/BuildGraph.fs +++ b/src/Compiler/Facilities/BuildGraph.fs @@ -105,6 +105,16 @@ type NodeCodeBuilder() = (value :> IDisposable).Dispose() } ) + + [] + member _.Using(value: IDisposable, binder: IDisposable -> NodeCode<'U>) = + Node( + async { + use _ = value + return! binder value |> Async.AwaitNodeCode + } + ) + let node = NodeCodeBuilder() diff --git a/src/Compiler/Facilities/BuildGraph.fsi b/src/Compiler/Facilities/BuildGraph.fsi index 76001d940da..b94c6e30b26 100644 --- a/src/Compiler/Facilities/BuildGraph.fsi +++ b/src/Compiler/Facilities/BuildGraph.fsi @@ -3,6 +3,7 @@ module internal FSharp.Compiler.BuildGraph open System +open System.Diagnostics open System.Threading open System.Threading.Tasks open FSharp.Compiler.DiagnosticsLogger @@ -43,10 +44,12 @@ type NodeCodeBuilder = member Combine: x1: NodeCode * x2: NodeCode<'T> -> NodeCode<'T> - /// A limited form 'use' for establishing the compilation globals. (Note - /// that a proper generic 'use' could be implemented but has not currently been necessary) + /// A limited form 'use' for establishing the compilation globals. member Using: CompilationGlobalsScope * (CompilationGlobalsScope -> NodeCode<'T>) -> NodeCode<'T> + /// A generic 'use' that disposes of the IDisposable at the end of the computation. + member Using: IDisposable * (IDisposable -> NodeCode<'T>) -> NodeCode<'T> + /// Specifies code that can be run as part of the build graph. val node: NodeCodeBuilder diff --git a/src/Compiler/Facilities/Logger.fs b/src/Compiler/Facilities/Logger.fs deleted file mode 100644 index dc425c506fe..00000000000 --- a/src/Compiler/Facilities/Logger.fs +++ /dev/null @@ -1,87 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace FSharp.Compiler.Diagnostics - -open System.Diagnostics.Tracing -open System - -type LogCompilerFunctionId = - | Service_ParseAndCheckFileInProject = 1 - | Service_CheckOneFile = 2 - | Service_IncrementalBuildersCache_BuildingNewCache = 3 - | Service_IncrementalBuildersCache_GettingCache = 4 - | CompileOps_TypeCheckOneInputAndFinishEventually = 5 - | IncrementalBuild_CreateItemKeyStoreAndSemanticClassification = 6 - | IncrementalBuild_TypeCheck = 7 - -/// This is for ETW tracing across FSharp.Compiler. -[] -type FSharpCompilerEventSource() = - inherit EventSource() - - static let instance = new FSharpCompilerEventSource() - static member Instance = instance - - [] - member this.Log(functionId: LogCompilerFunctionId) = - if this.IsEnabled() then this.WriteEvent(1, int functionId) - - [] - member this.LogMessage(message: string, functionId: LogCompilerFunctionId) = - if this.IsEnabled() then - this.WriteEvent(2, message, int functionId) - - [] - member this.BlockStart(functionId: LogCompilerFunctionId) = - if this.IsEnabled() then this.WriteEvent(3, int functionId) - - [] - member this.BlockStop(functionId: LogCompilerFunctionId) = - if this.IsEnabled() then this.WriteEvent(4, int functionId) - - [] - member this.BlockMessageStart(message: string, functionId: LogCompilerFunctionId) = - if this.IsEnabled() then - this.WriteEvent(5, message, int functionId) - - [] - member this.BlockMessageStop(message: string, functionId: LogCompilerFunctionId) = - if this.IsEnabled() then - this.WriteEvent(6, message, int functionId) - -[] -module Logger = - - let Log functionId = - FSharpCompilerEventSource.Instance.Log(functionId) - - let LogMessage message functionId = - FSharpCompilerEventSource.Instance.LogMessage(message, functionId) - - let LogBlockStart functionId = - FSharpCompilerEventSource.Instance.BlockStart(functionId) - - let LogBlockStop functionId = - FSharpCompilerEventSource.Instance.BlockStop(functionId) - - let LogBlockMessageStart message functionId = - FSharpCompilerEventSource.Instance.BlockMessageStart(message, functionId) - - let LogBlockMessageStop message functionId = - FSharpCompilerEventSource.Instance.BlockMessageStop(message, functionId) - - let LogBlock functionId = - FSharpCompilerEventSource.Instance.BlockStart(functionId) - - { new IDisposable with - member _.Dispose() = - FSharpCompilerEventSource.Instance.BlockStop(functionId) - } - - let LogBlockMessage message functionId = - FSharpCompilerEventSource.Instance.BlockMessageStart(message, functionId) - - { new IDisposable with - member _.Dispose() = - FSharpCompilerEventSource.Instance.BlockMessageStop(message, functionId) - } diff --git a/src/Compiler/Facilities/Logger.fsi b/src/Compiler/Facilities/Logger.fsi deleted file mode 100644 index 08134122864..00000000000 --- a/src/Compiler/Facilities/Logger.fsi +++ /dev/null @@ -1,33 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace FSharp.Compiler.Diagnostics - -open System - -type internal LogCompilerFunctionId = - | Service_ParseAndCheckFileInProject = 1 - | Service_CheckOneFile = 2 - | Service_IncrementalBuildersCache_BuildingNewCache = 3 - | Service_IncrementalBuildersCache_GettingCache = 4 - | CompileOps_TypeCheckOneInputAndFinishEventually = 5 - | IncrementalBuild_CreateItemKeyStoreAndSemanticClassification = 6 - | IncrementalBuild_TypeCheck = 7 - -[] -module internal Logger = - - val Log: LogCompilerFunctionId -> unit - - val LogMessage: message: string -> LogCompilerFunctionId -> unit - - val LogBlockStart: LogCompilerFunctionId -> unit - - val LogBlockStop: LogCompilerFunctionId -> unit - - val LogBlockMessageStart: message: string -> LogCompilerFunctionId -> unit - - val LogBlockMessageStop: message: string -> LogCompilerFunctionId -> unit - - val LogBlock: LogCompilerFunctionId -> IDisposable - - val LogBlockMessage: message: string -> LogCompilerFunctionId -> IDisposable diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index b6d64e22ec0..25c94ca5c5c 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -2347,6 +2347,7 @@ module internal ParseAndCheckFile = let parseFile (sourceText: ISourceText, fileName, options: FSharpParsingOptions, userOpName: string, suggestNamesForErrors: bool) = Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "parseFile", fileName) + use act = Activity.start "ParseAndCheckFile.parseFile" [| "fileName", fileName |] let errHandler = DiagnosticsHandler(true, fileName, options.DiagnosticOptions, sourceText, suggestNamesForErrors) @@ -2502,7 +2503,8 @@ module internal ParseAndCheckFile = ) = cancellable { - use _logBlock = Logger.LogBlock LogCompilerFunctionId.Service_CheckOneFile + use _ = + Activity.start "ParseAndCheckFile.CheckOneFile" [| "fileName", mainInputFileName; "length", sourceText.Length.ToString() |] let parsedMainInput = parseResults.ParseTree diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index f3655c4cab3..b8d9e4f648c 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -116,6 +116,7 @@ module IncrementalBuildSyntaxTree = let mutable weakCache: WeakReference<_> option = None let parse(sigNameOpt: QualifiedNameOfFile option) = + let diagnosticsLogger = CompilationDiagnosticLogger("Parse", tcConfig.diagnosticsOptions) // Return the disposable object that cleans up use _holder = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.Parse) @@ -123,6 +124,13 @@ module IncrementalBuildSyntaxTree = try IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBEParsed fileName) let canSkip = sigNameOpt.IsSome && FSharpImplFileSuffixes |> List.exists (FileSystemUtils.checkSuffix fileName) + use act = + Activity.start "IncrementalBuildSyntaxTree.parse" + [| + "fileName", source.FilePath + "buildPhase", BuildPhase.Parse.ToString() + "canSkip", canSkip.ToString() + |] let input = if canSkip then ParsedInput.ImplFile( @@ -465,6 +473,7 @@ type BoundModel private (tcConfig: TcConfig, let! res = defaultTypeCheck () return res | Some syntaxTree -> + use _ = Activity.start "BoundModel.TypeCheck" [|"fileName", syntaxTree.FileName|] let sigNameOpt = if partialCheck then this.BackingSignature @@ -489,8 +498,6 @@ type BoundModel private (tcConfig: TcConfig, let hadParseErrors = not (Array.isEmpty parseErrors) let input, moduleNamesDict = DeduplicateParsedInputModuleName prevModuleNamesDict input - Logger.LogBlockMessageStart fileName LogCompilerFunctionId.IncrementalBuild_TypeCheck - let! (tcEnvAtEndOfFile, topAttribs, implFile, ccuSigForFile), tcState = CheckOneInput ((fun () -> hadParseErrors || diagnosticsLogger.ErrorCount > 0), @@ -502,8 +509,6 @@ type BoundModel private (tcConfig: TcConfig, partialCheck) |> NodeCode.FromCancellable - Logger.LogBlockMessageStop fileName LogCompilerFunctionId.IncrementalBuild_TypeCheck - fileChecked.Trigger fileName let newErrors = Array.append parseErrors (capturingDiagnosticsLogger.Diagnostics |> List.toArray) let tcEnvAtEndOfFile = if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls @@ -531,7 +536,7 @@ type BoundModel private (tcConfig: TcConfig, // Build symbol keys let itemKeyStore, semanticClassification = if enableBackgroundItemKeyStoreAndSemanticClassification then - Logger.LogBlockMessageStart fileName LogCompilerFunctionId.IncrementalBuild_CreateItemKeyStoreAndSemanticClassification + use _ = Activity.start "IncrementalBuild.CreateItemKeyStoreAndSemanticClassification" [|"fileName", fileName|] let sResolutions = sink.GetResolutions() let builder = ItemKeyStoreBuilder() let preventDuplicates = HashSet({ new IEqualityComparer with @@ -549,7 +554,6 @@ type BoundModel private (tcConfig: TcConfig, sckBuilder.WriteAll semanticClassification let res = builder.TryBuildAndReset(), sckBuilder.TryBuildAndReset() - Logger.LogBlockMessageStop fileName LogCompilerFunctionId.IncrementalBuild_CreateItemKeyStoreAndSemanticClassification res else None, None @@ -1037,6 +1041,7 @@ module IncrementalBuilderStateHelpers = let rec createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: ImmutableArray>.Builder) = GraphNode(node { + use _ = Activity.start "GetCheckResultsAndImplementationsForProject" [|"projectOutFile", initialState.outfile|] // Compute last bound model then get all the evaluated models. let! _ = boundModels[boundModels.Count - 1].GetOrComputeValue() let boundModels = diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index 9328b513aa5..90215b6a8f5 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -274,6 +274,9 @@ type BackgroundCompiler /// creates an incremental builder used by the command line compiler. let CreateOneIncrementalBuilder (options: FSharpProjectOptions, userOpName) = node { + use _ = + Activity.start "BackgroundCompiler.CreateOneIncrementalBuilder" [| "project", options.ProjectFileName |] + Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "CreateOneIncrementalBuilder", options.ProjectFileName) let projectReferences = getProjectReferences options userOpName @@ -402,9 +405,7 @@ type BackgroundCompiler | Some getBuilder -> node { match! getBuilder with - | builderOpt, creationDiags when builderOpt.IsNone || not builderOpt.Value.IsReferencesInvalidated -> - Logger.Log LogCompilerFunctionId.Service_IncrementalBuildersCache_GettingCache - return builderOpt, creationDiags + | builderOpt, creationDiags when builderOpt.IsNone || not builderOpt.Value.IsReferencesInvalidated -> return builderOpt, creationDiags | _ -> // The builder could be re-created, // clear the check file caches that are associated with it. @@ -434,9 +435,7 @@ type BackgroundCompiler let getAnyBuilder (options, userOpName) = match tryGetAnyBuilder options with - | Some getBuilder -> - Logger.Log LogCompilerFunctionId.Service_IncrementalBuildersCache_GettingCache - getBuilder + | Some getBuilder -> getBuilder | _ -> getOrCreateBuilder (options, userOpName) static let mutable actualParseFileCount = 0 @@ -467,6 +466,9 @@ type BackgroundCompiler member _.ParseFile(fileName: string, sourceText: ISourceText, options: FSharpParsingOptions, cache: bool, userOpName: string) = async { + use _ = + Activity.start "BackgroundCompiler.ParseFile" [| "fileName", fileName; "userOpName", userOpName; "cache", cache.ToString() |] + if cache then let hash = sourceText.GetHashCode() |> int64 @@ -491,6 +493,9 @@ type BackgroundCompiler /// Fetch the parse information from the background compiler (which checks w.r.t. the FileSystem API) member _.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) = node { + use _ = + Activity.start "BackgroundCompiler.GetBackgroundParseResultsForFileInProject" [| "fileName", fileName; "userOpName", userOpName |] + let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -518,6 +523,7 @@ type BackgroundCompiler member _.GetCachedCheckFileResult(builder: IncrementalBuilder, fileName, sourceText: ISourceText, options) = node { + use _ = Activity.start "BackgroundCompiler.GetCachedCheckFileResult" [| "fileName", fileName |] let hash = sourceText.GetHashCode() |> int64 let key = (fileName, hash, options) let cachedResultsOpt = parseCacheLock.AcquireLock(fun ltok -> checkFileInProjectCache.TryGet(ltok, key)) @@ -620,6 +626,15 @@ type BackgroundCompiler userOpName ) = node { + use _ = + Activity.start + "BackgroundCompiler.CheckFileInProjectAllowingStaleCachedResults" + [| + "project", options.ProjectFileName + "fileName", fileName + "userOpName", userOpName + |] + let! cachedResults = node { let! builderOpt, creationDiags = getAnyBuilder (options, userOpName) @@ -653,6 +668,15 @@ type BackgroundCompiler /// Type-check the result obtained by parsing. Force the evaluation of the antecedent type checking context if needed. member bc.CheckFileInProject(parseResults: FSharpParseFileResults, fileName, fileVersion, sourceText: ISourceText, options, userOpName) = node { + use _ = + Activity.start + "BackgroundCompiler.CheckFileInProject" + [| + "project", options.ProjectFileName + "fileName", fileName + "userOpName", userOpName + |] + let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -672,15 +696,19 @@ type BackgroundCompiler /// Parses and checks the source file and returns untyped AST and check results. member bc.ParseAndCheckFileInProject(fileName: string, fileVersion, sourceText: ISourceText, options: FSharpProjectOptions, userOpName) = node { - let strGuid = "_ProjectId=" + (options.ProjectId |> Option.defaultValue "null") - Logger.LogBlockMessageStart (fileName + strGuid) LogCompilerFunctionId.Service_ParseAndCheckFileInProject + use _ = + Activity.start + "BackgroundCompiler.ParseAndCheckFileInProject" + [| + "project", options.ProjectFileName + "fileName", fileName + "userOpName", userOpName + |] let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with | None -> - Logger.LogBlockMessageStop (fileName + strGuid + "-Failed_Aborted") LogCompilerFunctionId.Service_ParseAndCheckFileInProject - let parseTree = EmptyParsedInput(fileName, (false, false)) let parseResults = FSharpParseFileResults(creationDiags, parseTree, true, [||]) return (parseResults, FSharpCheckFileAnswer.Aborted) @@ -689,10 +717,7 @@ type BackgroundCompiler let! cachedResults = bc.GetCachedCheckFileResult(builder, fileName, sourceText, options) match cachedResults with - | Some (parseResults, checkResults) -> - Logger.LogBlockMessageStop (fileName + strGuid + "-Successful_Cached") LogCompilerFunctionId.Service_ParseAndCheckFileInProject - - return (parseResults, FSharpCheckFileAnswer.Succeeded checkResults) + | Some (parseResults, checkResults) -> return (parseResults, FSharpCheckFileAnswer.Succeeded checkResults) | _ -> let! tcPrior = builder.GetCheckResultsBeforeFileInProject fileName let! tcInfo = tcPrior.GetOrComputeTcInfo() @@ -711,14 +736,21 @@ type BackgroundCompiler let! checkResults = bc.CheckOneFileImpl(parseResults, sourceText, fileName, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) - Logger.LogBlockMessageStop (fileName + strGuid + "-Successful") LogCompilerFunctionId.Service_ParseAndCheckFileInProject - return (parseResults, checkResults) } /// Fetch the check information from the background compiler (which checks w.r.t. the FileSystem API) member _.GetBackgroundCheckResultsForFileInProject(fileName, options, userOpName) = node { + use _ = + Activity.start + "BackgroundCompiler.ParseAndCheckFileInProject" + [| + "project", options.ProjectFileName + "fileName", fileName + "userOpName", userOpName + |] + let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -802,6 +834,16 @@ type BackgroundCompiler userOpName: string ) = node { + use _ = + Activity.start + "BackgroundCompiler.FindReferencesInFile" + [| + "project", options.ProjectFileName + "fileName", fileName + "userOpName", userOpName + "symbol", symbol.FullName + |] + let! builderOpt, _ = getOrCreateBuilderWithInvalidationFlag (options, canInvalidateProject, userOpName) match builderOpt with @@ -820,6 +862,15 @@ type BackgroundCompiler member _.GetSemanticClassificationForFile(fileName: string, options: FSharpProjectOptions, userOpName: string) = node { + use _ = + Activity.start + "BackgroundCompiler.GetSemanticClassificationForFile" + [| + "project", options.ProjectFileName + "fileName", fileName + "userOpName", userOpName + |] + let! builderOpt, _ = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -835,6 +886,15 @@ type BackgroundCompiler /// Try to get recent approximate type check results for a file. member _.TryGetRecentCheckResultsForFile(fileName: string, options: FSharpProjectOptions, sourceText: ISourceText option, _userOpName: string) = + use _ = + Activity.start + "BackgroundCompiler.GetSemanticClassificationForFile" + [| + "project", options.ProjectFileName + "fileName", fileName + "userOpName", _userOpName + |] + match sourceText with | Some sourceText -> let hash = sourceText.GetHashCode() |> int64 @@ -907,6 +967,9 @@ type BackgroundCompiler member _.GetAssemblyData(options, userOpName) = node { + use _ = + Activity.start "BackgroundCompiler.GetAssemblyData" [| "project", options.ProjectFileName; "userOpName", userOpName |] + let! builderOpt, _ = getOrCreateBuilder (options, userOpName) match builderOpt with @@ -927,6 +990,9 @@ type BackgroundCompiler /// Parse and typecheck the whole project. member bc.ParseAndCheckProject(options, userOpName) = + use _ = + Activity.start "BackgroundCompiler.ParseAndCheckProject" [| "project", options.ProjectFileName; "userOpName", userOpName |] + bc.ParseAndCheckProjectImpl(options, userOpName) member _.GetProjectOptionsFromScript @@ -943,6 +1009,9 @@ type BackgroundCompiler optionsStamp: int64 option, _userOpName ) = + use _ = + Activity.start "BackgroundCompiler.GetProjectOptionsFromScript" [| "fileName", fileName; "userOpName", _userOpName |] + cancellable { use diagnostics = new DiagnosticsScope() @@ -1027,6 +1096,9 @@ type BackgroundCompiler |> Cancellable.toAsync member bc.InvalidateConfiguration(options: FSharpProjectOptions, userOpName) = + use _ = + Activity.start "BackgroundCompiler.InvalidateConfiguration" [| "project", options.ProjectFileName; "userOpName", userOpName |] + if incrementalBuildersCache.ContainsSimilarKey(AnyCallerThread, options) then parseCacheLock.AcquireLock(fun ltok -> for sourceFile in options.SourceFiles do @@ -1036,11 +1108,16 @@ type BackgroundCompiler () member bc.ClearCache(options: seq, _userOpName) = + use _ = Activity.start "BackgroundCompiler.ClearCache" [| "userOpName", _userOpName |] + lock gate (fun () -> options |> Seq.iter (fun options -> incrementalBuildersCache.RemoveAnySimilar(AnyCallerThread, options))) member _.NotifyProjectCleaned(options: FSharpProjectOptions, userOpName) = + use _ = + Activity.start "BackgroundCompiler.NotifyProjectCleaned" [| "project", options.ProjectFileName; "userOpName", userOpName |] + async { let! ct = Async.CancellationToken // If there was a similar entry (as there normally will have been) then re-establish an empty builder . This @@ -1060,6 +1137,8 @@ type BackgroundCompiler member _.ProjectChecked = projectChecked.Publish member _.ClearCaches() = + use _ = Activity.startNoTags "BackgroundCompiler.ClearCaches" + lock gate (fun () -> parseCacheLock.AcquireLock(fun ltok -> checkFileInProjectCache.Clear(ltok) @@ -1070,6 +1149,8 @@ type BackgroundCompiler scriptClosureCache.Clear AnyCallerThread) member _.DownsizeCaches() = + use _ = Activity.startNoTags "BackgroundCompiler.DownsizeCaches" + lock gate (fun () -> parseCacheLock.AcquireLock(fun ltok -> checkFileInProjectCache.Resize(ltok, newKeepStrongly = 1) @@ -1160,6 +1241,8 @@ type FSharpChecker ?parallelReferenceResolution ) = + use _ = Activity.startNoTags "FSharpChecker.Create" + let legacyReferenceResolver = match legacyReferenceResolver with | Some rr -> rr @@ -1201,6 +1284,7 @@ type FSharpChecker member _.MatchBraces(fileName, sourceText: ISourceText, options: FSharpParsingOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" + use _ = Activity.start "FSharpChecker.MatchBraces" [| "fileName", fileName; "userOpName", userOpName |] let hash = sourceText.GetHashCode() |> int64 async { @@ -1252,6 +1336,7 @@ type FSharpChecker member _.Compile(argv: string[], ?userOpName: string) = let _userOpName = defaultArg userOpName "Unknown" + use _ = Activity.start "FSharpChecker.Compile" [| "userOpName", _userOpName |] async { let ctok = CompilationThreadToken() @@ -1270,6 +1355,9 @@ type FSharpChecker // This is for unit testing only member ic.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() = + use _ = + Activity.startNoTags "FsharpChecker.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients" + ic.ClearCaches() GC.Collect() GC.WaitForPendingFinalizers() diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs new file mode 100644 index 00000000000..2ae87433ce5 --- /dev/null +++ b/src/Compiler/Utilities/Activity.fs @@ -0,0 +1,25 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.Diagnostics + +open System +open System.Diagnostics + +[] +module Activity = + + let private activitySourceName = "fsc" + let private activitySource = new ActivitySource(activitySourceName) + + let start (name: string) (tags: (string * string) seq) : IDisposable = + let activity = activitySource.StartActivity(name) + + match activity with + | null -> () + | activity -> + for key, value in tags do + activity.AddTag(key, value) |> ignore + + activity + + let startNoTags (name: string) : IDisposable = activitySource.StartActivity(name) diff --git a/src/Compiler/Utilities/Activity.fsi b/src/Compiler/Utilities/Activity.fsi new file mode 100644 index 00000000000..edf0d890c19 --- /dev/null +++ b/src/Compiler/Utilities/Activity.fsi @@ -0,0 +1,14 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.Diagnostics + +open System + +/// For activities following the dotnet distributed tracing concept +/// https://learn.microsoft.com/en-us/dotnet/core/diagnostics/distributed-tracing-concepts?source=recommendations +[] +module internal Activity = + + val startNoTags: name: string -> IDisposable + + val start: name: string -> tags: (string * string) seq -> IDisposable diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index fcb2a84c35b..d0bb8f7843b 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -997,7 +997,7 @@ type CancellableBuilder() = match compRes with | ValueOrCancelled.Value res -> - (resource :> IDisposable).Dispose() + Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions.Dispose resource match res with | Choice1Of2 r -> ValueOrCancelled.Value r diff --git a/src/fsc/fsc.targets b/src/fsc/fsc.targets index 6dccff1eae3..01079442eac 100644 --- a/src/fsc/fsc.targets +++ b/src/fsc/fsc.targets @@ -48,6 +48,7 @@ + diff --git a/vsintegration/Directory.Build.targets b/vsintegration/Directory.Build.targets index 21ec3caa91f..8175eb49227 100644 --- a/vsintegration/Directory.Build.targets +++ b/vsintegration/Directory.Build.targets @@ -15,6 +15,7 @@ +