Implementation

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

@@ -17,6 +17,7 @@
 * Support literal attribute on decimals ([PR #17769](https://github.com/dotnet/fsharp/pull/17769))
 * Added type conversions cache, only enabled for compiler runs, guarded by language version preview ([PR#17668](https://github.com/dotnet/fsharp/pull/17668))
 * Added project property ParallelCompilation which turns on graph based type checking, parallel ILXGen and parallel optimization. By default on for users of langversion=preview ([PR#17948](https://github.com/dotnet/fsharp/pull/17948))
+* New flag `--reusetypecheckingresults`, for skipping recompilation in some cases
 
 ### Changed
 

src/Compiler/Driver/CompilerConfig.fs

@@ -444,6 +444,11 @@ type TypeCheckingMode =
     | Sequential
     | Graph
 
+[<RequireQualifiedAccess>]
+type ReuseTcResults =
+    | On
+    | Off
+
 [<RequireQualifiedAccess>]
 type TypeCheckingConfig =
     {
@@ -651,6 +656,8 @@ type TcConfigBuilder =
 
         mutable parallelReferenceResolution: ParallelReferenceResolution
 
+        mutable reuseTcResults: ReuseTcResults
+
         mutable captureIdentifiersWhenParsing: bool
 
         mutable typeCheckingConfig: TypeCheckingConfig
@@ -660,6 +667,8 @@ type TcConfigBuilder =
         mutable realsig: bool
 
         mutable compilationMode: TcGlobals.CompilationMode
+
+        mutable cmdLineArgs: string array
     }
 
     // Directories to start probing in
@@ -861,6 +870,7 @@ type TcConfigBuilder =
             xmlDocInfoLoader = None
             exiter = QuitProcessExiter
             parallelReferenceResolution = ParallelReferenceResolution.Off
+            reuseTcResults = ReuseTcResults.Off
             captureIdentifiersWhenParsing = false
             typeCheckingConfig =
                 {
@@ -875,6 +885,7 @@ type TcConfigBuilder =
             realsig = false
             strictIndentation = None
             compilationMode = TcGlobals.CompilationMode.Unset
+            cmdLineArgs = [||]
         }
 
     member tcConfigB.FxResolver =
@@ -1415,11 +1426,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

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

src/Compiler/Driver/ParseAndCheckInputs.fs

@@ -30,6 +30,7 @@ open FSharp.Compiler.IO
 open FSharp.Compiler.Lexhelp
 open FSharp.Compiler.NameResolution
 open FSharp.Compiler.ParseHelpers
+open FSharp.Compiler.ReuseTcResults
 open FSharp.Compiler.Syntax
 open FSharp.Compiler.SyntaxTrivia
 open FSharp.Compiler.Syntax.PrettyNaming
@@ -1961,6 +1962,10 @@ let CheckMultipleInputsUsingGraphMode
         partialResults, tcState)
 
 let CheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, eagerFormat, inputs) =
+
+    if tcConfig.reuseTcResults = ReuseTcResults.On then
+        ReuseTcResultsDriver(tcConfig).TryReuseTcResults(inputs)
+
     // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions
     let results, tcState =
         match tcConfig.typeCheckingConfig.Mode with

src/Compiler/Driver/ReuseTcResults/ReuseTcResultsDriver.fs

@@ -0,0 +1,124 @@
+module internal FSharp.Compiler.ReuseTcResults
+
+open System
+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
+
+open Internal.Utilities.Hashing
+
+let (++) a b = Path.Combine(a, b)
+
+[<Sealed>]
+type ReuseTcResultsDriver(tcConfig: TcConfig) =
+
+    let outputDir = tcConfig.outputDir |> Option.defaultValue ""
+    let tcDataFolderName = outputDir ++ FSharpTcDataResourceName
+
+    let cmdLineFilePath = tcDataFolderName ++ "cmdline"
+    let graphFilePath = tcDataFolderName ++ "graph"
+    let referencesFilePath = tcDataFolderName ++ "references"
+
+    let writeThisTcData path content =
+        use tcDataFile = FileSystem.OpenFileForWriteShim path
+        tcDataFile.WriteAllLines content
+
+    let readPrevTcData path =
+        if FileSystem.FileExistsShim path then
+            use tcDataFile = FileSystem.OpenFileForReadShim path
+            tcDataFile.ReadAllLines()
+        else
+            Array.empty
+
+    let getPrevCompilationCmdLine () = readPrevTcData cmdLineFilePath
+    let getPrevCompilationGraph () = readPrevTcData graphFilePath
+    let getPrevCompilationReferences () = readPrevTcData referencesFilePath
+
+    let writeThisCompilationCmdLine = writeThisTcData cmdLineFilePath
+    let writeThisCompilationGraph = writeThisTcData graphFilePath
+    let writeThisCompilationReferences = writeThisTcData referencesFilePath
+
+    let getContentHash fileName =
+        use stream = FileSystem.OpenFileForReadShim fileName
+        stream.ReadAllBytes() |> Md5Hasher.computeHash |> BitConverter.ToString
+
+    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 hash = getContentHash sourceFiles[idx].FileName
+            list.Add($"%i{idx}[\"{hash}\"]")
+
+        for KeyValue(idx, deps) in graph do
+            for depIdx in deps do
+                list.Add($"%i{idx} --> %i{depIdx}")
+
+        list.ToArray()
+
+    let getThisCompilationReferences =
+        List.map (fun (r: AssemblyReference) -> r.Text, getContentHash r.Text)
+        >> List.map (fun (name, hash) -> $"{name}: {hash}")
+        >> List.toArray
+
+    member _.TryReuseTcResults inputs =
+        if FileSystem.DirectoryExistsShim tcDataFolderName then
+            use _ = Activity.start Activity.Events.reuseTcResultsCachePresent []
+
+            let prevCompilationCmdLine = getPrevCompilationCmdLine ()
+            let thisCompilationCmdLine = getThisCompilationCmdLine tcConfig.cmdLineArgs
+
+            if prevCompilationCmdLine = thisCompilationCmdLine then
+
+                let prevCompilationReferences = getPrevCompilationReferences ()
+                let thisCompilationReferences = getThisCompilationReferences tcConfig.referencedDLLs
+
+                if prevCompilationReferences = thisCompilationReferences then
+
+                    let prevCompilationGraph = getPrevCompilationGraph ()
+                    let thisCompilationGraph = getThisCompilationGraph inputs
+
+                    if prevCompilationGraph = thisCompilationGraph then
+                        use _ = Activity.start Activity.Events.reuseTcResultsCacheHit []
+
+                        () // do nothing, yet
+                    else
+                        use _ = Activity.start Activity.Events.reuseTcResultsCacheMissed []
+
+                        writeThisCompilationGraph thisCompilationGraph
+                else
+                    use _ = Activity.start Activity.Events.reuseTcResultsCacheMissed []
+
+                    writeThisCompilationReferences thisCompilationReferences
+            else
+                use _ = Activity.start Activity.Events.reuseTcResultsCacheMissed []
+
+                writeThisCompilationCmdLine thisCompilationCmdLine
+        else
+            use _ = Activity.start Activity.Events.reuseTcResultsCacheAbsent []
+
+            let _ = FileSystem.DirectoryCreateShim tcDataFolderName
+            writeThisCompilationCmdLine (getThisCompilationCmdLine tcConfig.cmdLineArgs)
+            writeThisCompilationGraph (getThisCompilationGraph inputs)
+            writeThisCompilationReferences (getThisCompilationReferences tcConfig.referencedDLLs)

src/Compiler/Driver/ReuseTcResults/ReuseTcResultsDriver.fsi

@@ -0,0 +1,11 @@
+module internal FSharp.Compiler.ReuseTcResults
+
+open FSharp.Compiler.CompilerConfig
+open FSharp.Compiler.Syntax
+
+[<Sealed>]
+type ReuseTcResultsDriver =
+
+    new: tcConfig: TcConfig -> ReuseTcResultsDriver
+
+    member TryReuseTcResults: inputs: ParsedInput seq -> unit

src/Compiler/Driver/fsc.fs

@@ -511,6 +511,7 @@ let main1
         )
 
     tcConfigB.exiter <- exiter
+    tcConfigB.cmdLineArgs <- argv
 
     // Preset: --optimize+ -g --tailcalls+ (see 4505)
     SetOptimizeSwitch tcConfigB OptionSwitch.On

src/Compiler/FSComp.txt

@@ -1788,3 +1788,4 @@ featureUseTypeSubsumptionCache,"Use type conversion cache during compilation"
 featureDontWarnOnUppercaseIdentifiersInBindingPatterns,"Don't warn on uppercase identifiers in binding patterns"
 3873,chkDeprecatePlacesWhereSeqCanBeOmitted,"This construct is deprecated. Sequence expressions should be of the form 'seq {{ ... }}'"
 featureDeprecatePlacesWhereSeqCanBeOmitted,"Deprecate places where 'seq' can be omitted"
+optsReuseTcResults,"Reuse previous typechecking results for faster compilation"

src/Compiler/FSharp.Compiler.Service.fsproj

@@ -459,6 +459,8 @@
     <Compile Include="Driver\GraphChecking\GraphProcessing.fsi" />
     <Compile Include="Driver\GraphChecking\GraphProcessing.fs" />
     <Content Include="Driver\GraphChecking\Docs.md" />
+    <Compile Include="Driver\ReuseTcResults\ReuseTcResultsDriver.fsi" />
+    <Compile Include="Driver\ReuseTcResults\ReuseTcResultsDriver.fs" />
     <Compile Include="Driver\ParseAndCheckInputs.fsi" />
     <Compile Include="Driver\ParseAndCheckInputs.fs" />
     <Compile Include="Driver\ScriptClosure.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,12 @@ 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
 
     val start: name: string -> tags: (string * string) seq -> IDisposable