--reportTimeToFile:{path to csv} flag for fsc.exe writing out collected activities

FSharpBuild.Directory.Build.props

@@ -27,6 +27,7 @@
     <OtherFlags>$(OtherFlags) --nowarn:3384</OtherFlags>
     <OtherFlags>$(OtherFlags) --times --nowarn:75</OtherFlags>
     <OtherFlags Condition="$(ParallelCheckingWithSignatureFilesOn) == 'true'">$(OtherFlags) --test:ParallelCheckingWithSignatureFilesOn</OtherFlags>
+    <OtherFlags Condition="$(AdditionalFscCmdFlags) != ''">$(OtherFlags) $(AdditionalFscCmdFlags)</OtherFlags>
   </PropertyGroup>
 
   <!-- nuget -->

src/Compiler/Checking/CheckDeclarations.fs

@@ -5316,8 +5316,8 @@ let CheckOneImplFile
         use _ =
             Activity.start "CheckDeclarations.CheckOneImplFile"
                 [|
-                    "fileName", fileName
-                    "qualifiedNameOfFile", qualNameOfFile.Text
+                    Activity.Tags.fileName, fileName
+                    Activity.Tags.qualifiedNameOfFile, qualNameOfFile.Text
                 |]
         let cenv =
             cenv.Create (g, isScript, amap, thisCcu, false, Option.isSome rootSigOpt,
@@ -5450,8 +5450,8 @@ let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSin
     use _ =
         Activity.start "CheckDeclarations.CheckOneSigFile"
             [|
-                "fileName", sigFile.FileName
-                "qualifiedNameOfFile", sigFile.QualifiedName.Text
+                Activity.Tags.fileName, sigFile.FileName
+                Activity.Tags.qualifiedNameOfFile, sigFile.QualifiedName.Text
             |]
     let cenv =
         cenv.Create 

src/Compiler/Driver/CompilerConfig.fs

@@ -517,6 +517,7 @@ type TcConfigBuilder =
 
         /// show times between passes?
         mutable showTimes: bool
+        mutable writeTimesToFile: string option
         mutable showLoadedAssemblies: bool
         mutable continueAfterParseFailure: bool
 
@@ -740,6 +741,7 @@ type TcConfigBuilder =
             productNameForBannerText = FSharpProductName
             showBanner = true
             showTimes = false
+            writeTimesToFile = None
             showLoadedAssemblies = false
             continueAfterParseFailure = false
 #if !NO_TYPEPROVIDERS
@@ -1296,6 +1298,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) =
     member _.productNameForBannerText = data.productNameForBannerText
     member _.showBanner = data.showBanner
     member _.showTimes = data.showTimes
+    member _.writeTimesToFile = data.writeTimesToFile
     member _.showLoadedAssemblies = data.showLoadedAssemblies
     member _.continueAfterParseFailure = data.continueAfterParseFailure
 #if !NO_TYPEPROVIDERS

src/Compiler/Driver/CompilerConfig.fsi

@@ -426,6 +426,8 @@ type TcConfigBuilder =
 
         mutable showTimes: bool
 
+        mutable writeTimesToFile: string option
+
         mutable showLoadedAssemblies: bool
 
         mutable continueAfterParseFailure: bool
@@ -748,6 +750,8 @@ type TcConfig =
 
     member showTimes: bool
 
+    member writeTimesToFile: string option
+
     member showLoadedAssemblies: bool
 
     member continueAfterParseFailure: bool

src/Compiler/Driver/CompilerOptions.fs

@@ -1741,6 +1741,15 @@ let internalFlags (tcConfigB: TcConfigBuilder) =
             None
         )
 
+        // "Write timing profiles for compilation to a file"
+        CompilerOption(
+            "times",
+            tagFile,
+            OptionString(fun s -> tcConfigB.writeTimesToFile <- Some s),
+            Some(InternalCommandLineOption("times", rangeCmdArgs)),
+            None
+        )
+
 #if !NO_TYPEPROVIDERS
         // "Display information about extension type resolution")
         CompilerOption(
@@ -2339,39 +2348,40 @@ let PrintWholeAssemblyImplementation (tcConfig: TcConfig) outfile header expr =
 let mutable tPrev: (DateTime * DateTime * float * int[]) option = None
 let mutable nPrev: (string * IDisposable) option = None
 
+let private SimulateException simulateConfig =
+    match simulateConfig with
+    | Some ("fsc-oom") -> raise (OutOfMemoryException())
+    | Some ("fsc-an") -> raise (ArgumentNullException("simulated"))
+    | Some ("fsc-invop") -> raise (InvalidOperationException())
+    | Some ("fsc-av") -> raise (AccessViolationException())
+    | Some ("fsc-aor") -> raise (ArgumentOutOfRangeException())
+    | Some ("fsc-dv0") -> raise (DivideByZeroException())
+    | Some ("fsc-nfn") -> raise (NotFiniteNumberException())
+    | Some ("fsc-oe") -> raise (OverflowException())
+    | Some ("fsc-atmm") -> raise (ArrayTypeMismatchException())
+    | Some ("fsc-bif") -> raise (BadImageFormatException())
+    | Some ("fsc-knf") -> raise (System.Collections.Generic.KeyNotFoundException())
+    | Some ("fsc-ior") -> raise (IndexOutOfRangeException())
+    | Some ("fsc-ic") -> raise (InvalidCastException())
+    | Some ("fsc-ip") -> raise (InvalidProgramException())
+    | Some ("fsc-ma") -> raise (MemberAccessException())
+    | Some ("fsc-ni") -> raise (NotImplementedException())
+    | Some ("fsc-nr") -> raise (NullReferenceException())
+    | Some ("fsc-oc") -> raise (OperationCanceledException())
+    | Some ("fsc-fail") -> failwith "simulated"
+    | _ -> ()
+
 let ReportTime (tcConfig: TcConfig) descr =
     match nPrev with
     | None -> ()
-    | Some (prevDescr, prevActivity) ->
-        use _ = prevActivity // Finish the previous diagnostics activity by .Dispose() at the end of this block
-
+    | Some (prevDescr, _) ->
         if tcConfig.pause then
             dprintf "[done '%s', entering '%s'] press <enter> to continue... " prevDescr descr
             Console.ReadLine() |> ignore
         // Intentionally putting this right after the pause so a debugger can be attached.
-        match tcConfig.simulateException with
-        | Some ("fsc-oom") -> raise (OutOfMemoryException())
-        | Some ("fsc-an") -> raise (ArgumentNullException("simulated"))
-        | Some ("fsc-invop") -> raise (InvalidOperationException())
-        | Some ("fsc-av") -> raise (AccessViolationException())
-        | Some ("fsc-aor") -> raise (ArgumentOutOfRangeException())
-        | Some ("fsc-dv0") -> raise (DivideByZeroException())
-        | Some ("fsc-nfn") -> raise (NotFiniteNumberException())
-        | Some ("fsc-oe") -> raise (OverflowException())
-        | Some ("fsc-atmm") -> raise (ArrayTypeMismatchException())
-        | Some ("fsc-bif") -> raise (BadImageFormatException())
-        | Some ("fsc-knf") -> raise (System.Collections.Generic.KeyNotFoundException())
-        | Some ("fsc-ior") -> raise (IndexOutOfRangeException())
-        | Some ("fsc-ic") -> raise (InvalidCastException())
-        | Some ("fsc-ip") -> raise (InvalidProgramException())
-        | Some ("fsc-ma") -> raise (MemberAccessException())
-        | Some ("fsc-ni") -> raise (NotImplementedException())
-        | Some ("fsc-nr") -> raise (NullReferenceException())
-        | Some ("fsc-oc") -> raise (OperationCanceledException())
-        | Some ("fsc-fail") -> failwith "simulated"
-        | _ -> ()
+        SimulateException tcConfig.simulateException
 
-    if (tcConfig.showTimes || verbose) then
+    if (tcConfig.showTimes || verbose || tcConfig.writeTimesToFile.IsSome) then
         // Note that timing calls are relatively expensive on the startup path so we don't
         // make this call unless showTimes has been turned on.
         let p = Process.GetCurrentProcess()
@@ -2383,12 +2393,30 @@ 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, prevActivity) ->
                 let spanGC = [| for i in 0..maxGen -> GC.CollectionCount i - gcPrev[i] |]
                 let t = tNow - tStart
                 let tDelta = tNow - tPrev
                 let utDelta = utNow - utPrev
 
+                match prevActivity with
+                | :? System.Diagnostics.Activity as a when isNotNull a ->
+                    // Yes, there is duplicity of code between the console reporting and Activity collection right now.
+                    // If current --times behaviour can be changed (=breaking change to the layout etc.), the GC and CPU time collecting logic can move to Activity
+                    // (if a special Tag is set for an activity, the listener itself could evaluate CPU and GC info and set it
+                    a.AddTag(Activity.Tags.gc0, spanGC[Operators.min 0 maxGen]) |> ignore
+                    a.AddTag(Activity.Tags.gc1, spanGC[Operators.min 1 maxGen]) |> ignore
+                    a.AddTag(Activity.Tags.gc2, spanGC[Operators.min 2 maxGen]) |> ignore
+
+                    a.AddTag(Activity.Tags.outputDllFile, tcConfig.outputFile |> Option.defaultValue String.Empty)
+                    |> ignore
+
+                    a.AddTag(Activity.Tags.cpuDelta, utDelta.ToString("000.000")) |> ignore
+
+                    a.AddTag(Activity.Tags.realDelta, tDelta.TotalSeconds.ToString("000.000"))
+                    |> ignore
+                | _ -> ()
+
                 printf
                     "Real: %4.1f Realdelta: %4.1f Cpu: %4.1f Cpudelta: %4.1f Mem: %3d"
                     t.TotalSeconds
@@ -2410,6 +2438,11 @@ let ReportTime (tcConfig: TcConfig) descr =
 
         tPrev <- Some(tStart, tNow, utNow, gcNow)
 
+    nPrev
+    |> Option.iter (fun (_, act) ->
+        if isNotNull act then
+            act.Dispose())
+
     nPrev <- Some(descr, Activity.startNoTags descr)
 
 let ignoreFailureOnMono1_1_16 f =

src/Compiler/Driver/ParseAndCheckInputs.fs

@@ -1205,7 +1205,7 @@ let CheckOneInputAux
     cancellable {
         try
             use _ =
-                Activity.start "ParseAndCheckInputs.CheckOneInput" [| "fileName", inp.FileName |]
+                Activity.start "ParseAndCheckInputs.CheckOneInput" [| Activity.Tags.fileName, inp.FileName |]
 
             CheckSimulateException tcConfig
 

src/Compiler/Driver/fsc.fs

@@ -576,6 +576,17 @@ let main1
             delayForFlagsLogger.CommitDelayedDiagnostics(diagnosticsLoggerProvider, tcConfigB, exiter)
             exiter.Exit 1
 
+    tcConfig.writeTimesToFile
+    |> Option.iter (fun f ->
+        Activity.addCsvFileListener f |> disposables.Register
+
+        Activity.start
+            "FSC compilation"
+            [
+                Activity.Tags.outputDllFile, tcConfig.outputFile |> Option.defaultValue String.Empty
+            ]
+        |> disposables.Register)
+
     let diagnosticsLogger = diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter)
 
     // Install the global error logger and never remove it. This logger does have all command-line flags considered.

src/Compiler/Service/FSharpCheckerResults.fs

@@ -2347,7 +2347,9 @@ 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 |]
+
+        use act =
+            Activity.start "ParseAndCheckFile.parseFile" [| Activity.Tags.fileName, fileName |]
 
         let errHandler =
             DiagnosticsHandler(true, fileName, options.DiagnosticOptions, sourceText, suggestNamesForErrors)
@@ -2504,7 +2506,12 @@ module internal ParseAndCheckFile =
 
         cancellable {
             use _ =
-                Activity.start "ParseAndCheckFile.CheckOneFile" [| "fileName", mainInputFileName; "length", sourceText.Length.ToString() |]
+                Activity.start
+                    "ParseAndCheckFile.CheckOneFile"
+                    [|
+                        Activity.Tags.fileName, mainInputFileName
+                        Activity.Tags.length, sourceText.Length.ToString()
+                    |]
 
             let parsedMainInput = parseResults.ParseTree
 

src/Compiler/Service/IncrementalBuild.fs

@@ -127,7 +127,7 @@ module IncrementalBuildSyntaxTree =
                 use act =
                     Activity.start "IncrementalBuildSyntaxTree.parse"
                         [|
-                            "fileName", source.FilePath
+                            Activity.Tags.fileName, source.FilePath
                             "buildPhase", BuildPhase.Parse.ToString()
                             "canSkip", canSkip.ToString()
                         |]             
@@ -475,7 +475,7 @@ type BoundModel private (tcConfig: TcConfig,
                 let! res = defaultTypeCheck ()
                 return res
             | Some syntaxTree ->
-                use _ = Activity.start "BoundModel.TypeCheck" [|"fileName", syntaxTree.FileName|]
+                use _ = Activity.start "BoundModel.TypeCheck" [|Activity.Tags.fileName, syntaxTree.FileName|]
                 let sigNameOpt =
                     if partialCheck then
                         this.BackingSignature
@@ -538,7 +538,7 @@ type BoundModel private (tcConfig: TcConfig,
                         // Build symbol keys
                         let itemKeyStore, semanticClassification =
                             if enableBackgroundItemKeyStoreAndSemanticClassification then
-                                use _ = Activity.start "IncrementalBuild.CreateItemKeyStoreAndSemanticClassification" [|"fileName", fileName|]
+                                use _ = Activity.start "IncrementalBuild.CreateItemKeyStoreAndSemanticClassification" [|Activity.Tags.fileName, fileName|]
                                 let sResolutions = sink.GetResolutions()
                                 let builder = ItemKeyStoreBuilder()
                                 let preventDuplicates = HashSet({ new IEqualityComparer<struct(pos * pos)> with
@@ -1043,7 +1043,7 @@ module IncrementalBuilderStateHelpers =
 
     let rec createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: ImmutableArray<GraphNode<BoundModel>>.Builder) =
         GraphNode(node {
-            use _ = Activity.start "GetCheckResultsAndImplementationsForProject" [|"projectOutFile", initialState.outfile|]
+            use _ = Activity.start "GetCheckResultsAndImplementationsForProject" [|Activity.Tags.outputDllFile, initialState.outfile|]
             // Compute last bound model then get all the evaluated models.
             let! _ = boundModels[boundModels.Count - 1].GetOrComputeValue()
             let boundModels =