Reuse typechecking results - stage 1

docs/release-notes/.FSharp.Compiler.Service/9.0.200.md

@@ -27,6 +27,7 @@
 
 ### Added
 
+* New flag `--reusetypecheckingresults`, for skipping recompilation in some cases
 * Let `dotnet fsi --help` print a link to the documentation website. ([PR #18006](https://github.com/dotnet/fsharp/pull/18006))
 * Deprecate places where `seq` can be omitted. ([Language suggestion #1033](https://github.com/fsharp/fslang-suggestions/issues/1033), [PR #17772](https://github.com/dotnet/fsharp/pull/17772))
 * Support literal attribute on decimals ([PR #17769](https://github.com/dotnet/fsharp/pull/17769))

src/Compiler/Driver/CompilerConfig.fs

@@ -445,6 +445,11 @@ type TypeCheckingMode =
     | Sequential
     | Graph
 
+[<RequireQualifiedAccess>]
+type ReuseTcResults =
+    | On
+    | Off
+
 [<RequireQualifiedAccess>]
 type TypeCheckingConfig =
     {
@@ -652,6 +657,8 @@ type TcConfigBuilder =
 
         mutable parallelReferenceResolution: ParallelReferenceResolution
 
+        mutable reuseTcResults: ReuseTcResults
+
         mutable captureIdentifiersWhenParsing: bool
 
         mutable typeCheckingConfig: TypeCheckingConfig
@@ -661,6 +668,8 @@ type TcConfigBuilder =
         mutable realsig: bool
 
         mutable compilationMode: TcGlobals.CompilationMode
+
+        mutable cmdLineArgs: string array
     }
 
     // Directories to start probing in
@@ -859,6 +868,7 @@ type TcConfigBuilder =
             xmlDocInfoLoader = None
             exiter = QuitProcessExiter
             parallelReferenceResolution = ParallelReferenceResolution.Off
+            reuseTcResults = ReuseTcResults.Off
             captureIdentifiersWhenParsing = false
             typeCheckingConfig =
                 {
@@ -873,6 +883,7 @@ type TcConfigBuilder =
             realsig = false
             strictIndentation = None
             compilationMode = TcGlobals.CompilationMode.Unset
+            cmdLineArgs = [||]
         }
 
     member tcConfigB.FxResolver =
@@ -1413,11 +1424,13 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) =
     member _.xmlDocInfoLoader = data.xmlDocInfoLoader
     member _.exiter = data.exiter
     member _.parallelReferenceResolution = data.parallelReferenceResolution
+    member _.reuseTcResults = data.reuseTcResults
     member _.captureIdentifiersWhenParsing = data.captureIdentifiersWhenParsing
     member _.typeCheckingConfig = data.typeCheckingConfig
     member _.dumpSignatureData = data.dumpSignatureData
     member _.realsig = data.realsig
     member _.compilationMode = data.compilationMode
+    member _.cmdLineArgs = data.cmdLineArgs
 
     static member Create(builder, validate) =
         use _ = UseBuildPhase BuildPhase.Parameter

src/Compiler/Driver/CompilerConfig.fsi

@@ -208,6 +208,11 @@ type ParallelReferenceResolution =
     | On
     | Off
 
+[<RequireQualifiedAccess>]
+type ReuseTcResults =
+    | On
+    | Off
+
 /// Determines the algorithm used for type-checking.
 [<RequireQualifiedAccess>]
 type TypeCheckingMode =
@@ -519,6 +524,8 @@ type TcConfigBuilder =
 
         mutable parallelReferenceResolution: ParallelReferenceResolution
 
+        mutable reuseTcResults: ReuseTcResults
+
         mutable captureIdentifiersWhenParsing: bool
 
         mutable typeCheckingConfig: TypeCheckingConfig
@@ -528,6 +535,8 @@ type TcConfigBuilder =
         mutable realsig: bool
 
         mutable compilationMode: TcGlobals.CompilationMode
+
+        mutable cmdLineArgs: string array
     }
 
     static member CreateNew:
@@ -899,6 +908,8 @@ type TcConfig =
 
     member parallelReferenceResolution: ParallelReferenceResolution
 
+    member reuseTcResults: ReuseTcResults
+
     member captureIdentifiersWhenParsing: bool
 
     member typeCheckingConfig: TypeCheckingConfig
@@ -909,6 +920,8 @@ type TcConfig =
 
     member compilationMode: TcGlobals.CompilationMode
 
+    member cmdLineArgs: string array
+
 /// Represents a computation to return a TcConfig. Normally this is just a constant immutable TcConfig,
 /// but for F# Interactive it may be based on an underlying mutable TcConfigBuilder.
 [<Sealed>]

src/Compiler/Driver/CompilerOptions.fs

@@ -1388,6 +1388,14 @@ let advancedFlagsFsc tcConfigB =
             None,
             Some(FSComp.SR.optsEmitDebugInfoInQuotations (formatOptionSwitch tcConfigB.emitDebugInfoInQuotations))
         )
+
+        CompilerOption(
+            "reusetypecheckingresults",
+            tagNone,
+            OptionUnit(fun () -> tcConfigB.reuseTcResults <- ReuseTcResults.On),
+            None,
+            Some(FSComp.SR.optsReuseTcResults ())
+        )
     ]
 
 // OptionBlock: Internal options (test use only)

src/Compiler/Driver/ReuseTcResults/CachingDriver.fs

@@ -0,0 +1,141 @@
+module internal FSharp.Compiler.ReuseTcResults
+
+open System.Collections.Generic
+open System.IO
+
+open FSharp.Compiler.CompilerConfig
+open FSharp.Compiler.Diagnostics
+open FSharp.Compiler.GraphChecking
+open FSharp.Compiler.IO
+open FSharp.Compiler.Syntax
+open FSharp.Compiler.Syntax.PrettyNaming
+
+type TcData =
+    {
+        CmdLine: string array
+        Graph: string array
+        References: string array
+    }
+
+[<Sealed>]
+type CachingDriver(tcConfig: TcConfig) =
+
+    let outputDir = tcConfig.outputDir |> Option.defaultValue ""
+    let tcDataFilePath = Path.Combine(outputDir, FSharpTcDataResourceName)
+
+    [<Literal>]
+    let CmdLineHeader = "CMDLINE"
+
+    [<Literal>]
+    let GraphHeader = "GRAPH"
+
+    [<Literal>]
+    let ReferencesHeader = "REFERENCES"
+
+    let writeThisTcData (tcData: TcData) =
+        use tcDataFile = FileSystem.OpenFileForWriteShim tcDataFilePath
+
+        let lines = ResizeArray<string>()
+        lines.Add $"BEGIN {CmdLineHeader}"
+        lines.AddRange tcData.CmdLine
+        lines.Add $"BEGIN {GraphHeader}"
+        lines.AddRange tcData.Graph
+        lines.Add $"BEGIN {ReferencesHeader}"
+        lines.AddRange tcData.References
+
+        tcDataFile.WriteAllLines lines
+
+    let readPrevTcData () =
+        if FileSystem.FileExistsShim tcDataFilePath then
+            use tcDataFile = FileSystem.OpenFileForReadShim tcDataFilePath
+
+            let cmdLine = ResizeArray<string>()
+            let graph = ResizeArray<string>()
+            let refs = ResizeArray<string>()
+
+            let mutable currentHeader = ""
+
+            tcDataFile.ReadLines()
+            |> Seq.iter (fun line ->
+                match line with
+                | line when line.StartsWith "BEGIN" -> currentHeader <- line.Split ' ' |> Array.last
+                | line ->
+                    match currentHeader with
+                    | CmdLineHeader -> cmdLine.Add line
+                    | GraphHeader -> graph.Add line
+                    | ReferencesHeader -> refs.Add line
+                    | _ -> invalidOp "broken tc cache")
+
+            Some
+                {
+                    CmdLine = cmdLine.ToArray()
+                    Graph = graph.ToArray()
+                    References = refs.ToArray()
+                }
+
+        else
+            None
+
+    let formatAssemblyReference (r: AssemblyReference) =
+        let fileName = r.Text
+        let lastWriteTime = FileSystem.GetLastWriteTimeShim fileName
+        sprintf "%s,%i" fileName lastWriteTime.Ticks
+
+    let getThisCompilationCmdLine args = args
+
+    // maybe split into two things?
+    let getThisCompilationGraph inputs =
+        let sourceFiles =
+            inputs
+            |> Seq.toArray
+            |> Array.mapi (fun idx (input: ParsedInput) ->
+                {
+                    Idx = idx
+                    FileName = input.FileName
+                    ParsedInput = input
+                })
+
+        let filePairs = FilePairMap sourceFiles
+        let graph, _ = DependencyResolution.mkGraph filePairs sourceFiles
+
+        let list = List<string>()
+
+        for KeyValue(idx, _) in graph do
+            let fileName = sourceFiles[idx].FileName
+            let lastWriteTime = FileSystem.GetLastWriteTimeShim fileName
+            list.Add(sprintf "%i,%s,%i" idx fileName lastWriteTime.Ticks)
+
+        for KeyValue(idx, deps) in graph do
+            for depIdx in deps do
+                list.Add $"%i{idx} --> %i{depIdx}"
+
+        list.ToArray()
+
+    let getThisCompilationReferences = Seq.map formatAssemblyReference >> Seq.toArray
+
+    member _.CanReuseTcResults inputs =
+        let prevTcDataOpt = readPrevTcData ()
+
+        let thisTcData =
+            {
+                CmdLine = getThisCompilationCmdLine tcConfig.cmdLineArgs
+                Graph = getThisCompilationGraph inputs
+                References = getThisCompilationReferences tcConfig.referencedDLLs
+            }
+
+        match prevTcDataOpt with
+        | Some prevTcData ->
+            use _ = Activity.start Activity.Events.reuseTcResultsCachePresent []
+
+            if prevTcData = thisTcData then
+                use _ = Activity.start Activity.Events.reuseTcResultsCacheHit []
+                true
+            else
+                use _ = Activity.start Activity.Events.reuseTcResultsCacheMissed []
+                writeThisTcData thisTcData
+                false
+
+        | None ->
+            use _ = Activity.start Activity.Events.reuseTcResultsCacheAbsent []
+            writeThisTcData thisTcData
+            false

src/Compiler/Driver/fsc.fs

@@ -54,6 +54,7 @@ open FSharp.Compiler.TypedTree
 open FSharp.Compiler.TypedTreeOps
 open FSharp.Compiler.XmlDocFileWriter
 open FSharp.Compiler.CheckExpressionsOps
+open ReuseTcResults
 
 //----------------------------------------------------------------------------
 // Reporting - warnings, errors
@@ -162,6 +163,13 @@ let TypeCheck
 
         let eagerFormat (diag: PhasedDiagnostic) = diag.EagerlyFormatCore true
 
+        if tcConfig.reuseTcResults = ReuseTcResults.On then
+            let cachingDriver = CachingDriver(tcConfig)
+
+            if cachingDriver.CanReuseTcResults(inputs) then
+                // do nothing, yet
+                ()
+
         CheckClosedInputSet(
             ctok,
             (fun () -> diagnosticsLogger.CheckForRealErrorsIgnoringWarnings),
@@ -511,6 +519,7 @@ let main1
         )
 
     tcConfigB.exiter <- exiter
+    tcConfigB.cmdLineArgs <- argv
 
     // Preset: --optimize+ -g --tailcalls+ (see 4505)
     SetOptimizeSwitch tcConfigB OptionSwitch.On

src/Compiler/FSComp.txt

@@ -1794,3 +1794,4 @@ featureDontWarnOnUppercaseIdentifiersInBindingPatterns,"Don't warn on uppercase
 3874,tcExpectedTypeParamMarkedWithUnitOfMeasureAttribute,"Expected unit-of-measure type parameter must be marked with the [<Measure>] attribute."
 featureDeprecatePlacesWhereSeqCanBeOmitted,"Deprecate places where 'seq' can be omitted"
 featureSupportValueOptionsAsOptionalParameters,"Support ValueOption as valid type for optional member parameters"
+optsReuseTcResults,"Reuse previous typechecking results for faster compilation"

src/Compiler/FSharp.Compiler.Service.fsproj

@@ -464,6 +464,7 @@
     <Content Include="Driver\GraphChecking\Docs.md" />
     <Compile Include="Driver\ParseAndCheckInputs.fsi" />
     <Compile Include="Driver\ParseAndCheckInputs.fs" />
+    <Compile Include="Driver\ReuseTcResults\CachingDriver.fs" />
     <Compile Include="Driver\ScriptClosure.fsi" />
     <Compile Include="Driver\ScriptClosure.fs" />
     <Compile Include="Driver\CompilerOptions.fsi" />

src/Compiler/SyntaxTree/PrettyNaming.fs

@@ -1132,6 +1132,8 @@ let FSharpSignatureCompressedDataResourceNameB = "FSharpSignatureCompressedDataB
 let FSharpOptimizationDataResourceName2 = "FSharpOptimizationInfo."
 let FSharpSignatureDataResourceName2 = "FSharpSignatureInfo."
 
+let FSharpTcDataResourceName = "FSharpTypecheckingData"
+
 [<Literal>]
 let suffixForVariablesThatMayNotBeEliminated = "$cont"
 

src/Compiler/SyntaxTree/PrettyNaming.fsi

@@ -284,6 +284,8 @@ val internal FSharpOptimizationDataResourceName2: string
 
 val internal FSharpSignatureDataResourceName2: string
 
+val internal FSharpTcDataResourceName: string
+
 val GetLongNameFromString: string -> string list
 
 val FormatAndOtherOverloadsString: int -> string

src/Compiler/Utilities/Activity.fs

@@ -69,6 +69,12 @@ module internal Activity =
     module Events =
         let cacheHit = "cacheHit"
 
+        let reuseTcResultsCachePrefix = "reuseTcResultsCache"
+        let reuseTcResultsCachePresent = $"{reuseTcResultsCachePrefix}Present"
+        let reuseTcResultsCacheAbsent = $"{reuseTcResultsCachePrefix}Absent"
+        let reuseTcResultsCacheHit = $"{reuseTcResultsCachePrefix}Hit"
+        let reuseTcResultsCacheMissed = $"{reuseTcResultsCachePrefix}Missed"
+
     type Diagnostics.Activity with
 
         member this.RootId =

src/Compiler/Utilities/Activity.fsi

@@ -39,6 +39,11 @@ module internal Activity =
 
     module Events =
         val cacheHit: string
+        val reuseTcResultsCachePrefix: string
+        val reuseTcResultsCachePresent: string
+        val reuseTcResultsCacheAbsent: string
+        val reuseTcResultsCacheHit: string
+        val reuseTcResultsCacheMissed: string
 
     val startNoTags: name: string -> IDisposable MaybeNull