From ef6d5f25f11624aadc4e8cbed6b625a4ba864ba7 Mon Sep 17 00:00:00 2001 From: dawe Date: Thu, 8 Feb 2024 12:38:52 +0100 Subject: [PATCH] Add script support to the TransparentCompiler (#16627) --- src/Compiler/Service/TransparentCompiler.fs | 234 ++++++++++++------ src/Compiler/Service/TransparentCompiler.fsi | 2 + .../FSharpChecker/TransparentCompiler.fs | 54 ++++ .../ProjectGeneration.fs | 11 +- 4 files changed, 222 insertions(+), 79 deletions(-) diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index 9f3881ecfd2..0795cb6c17a 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -291,6 +291,8 @@ type internal CompilerCaches(sizeFactor: int) = member val ItemKeyStore = AsyncMemoize(sf, 2 * sf, name = "ItemKeyStore") + member val ScriptClosure = AsyncMemoize(sf, 2 * sf, name = "ScriptClosure") + member this.Clear(projects: Set) = let shouldClear project = projects |> Set.contains project @@ -303,6 +305,7 @@ type internal CompilerCaches(sizeFactor: int) = this.AssemblyData.Clear(shouldClear) this.SemanticClassification.Clear(snd >> shouldClear) this.ItemKeyStore.Clear(snd >> shouldClear) + this.ScriptClosure.Clear(snd >> shouldClear) // Todo check if correct predicate type internal TransparentCompiler ( @@ -366,6 +369,52 @@ type internal TransparentCompiler ) :> IBackgroundCompiler + let ComputeScriptClosure + (fileName: string) + (source: ISourceText) + (defaultFSharpBinariesDir: string) + (useSimpleResolution: bool) + (useFsiAuxLib: bool option) + (useSdkRefs: bool option) + (sdkDirOverride: string option) + (assumeDotNetFramework: bool option) + (projectSnapshot: ProjectSnapshot) + = + caches.ScriptClosure.Get( + projectSnapshot.FileKey fileName, + node { + let useFsiAuxLib = defaultArg useFsiAuxLib true + let useSdkRefs = defaultArg useSdkRefs true + let reduceMemoryUsage = ReduceMemoryFlag.Yes + let assumeDotNetFramework = defaultArg assumeDotNetFramework false + + let applyCompilerOptions tcConfig = + let fsiCompilerOptions = GetCoreFsiCompilerOptions tcConfig + ParseCompilerOptions(ignore, fsiCompilerOptions, projectSnapshot.OtherOptions) + + let closure = + LoadClosure.ComputeClosureOfScriptText( + legacyReferenceResolver, + defaultFSharpBinariesDir, + fileName, + source, + CodeContext.Editing, + useSimpleResolution, + useFsiAuxLib, + useSdkRefs, + sdkDirOverride, + Lexhelp.LexResourceManager(), + applyCompilerOptions, + assumeDotNetFramework, + tryGetMetadataSnapshot, + reduceMemoryUsage, + dependencyProviderForScripts + ) + + return closure + } + ) + let ComputeFrameworkImports (tcConfig: TcConfig) frameworkDLLs nonFrameworkResolutions = let frameworkDLLsKey = frameworkDLLs @@ -576,90 +625,113 @@ type internal TransparentCompiler } ] - let ComputeTcConfigBuilder (projectSnapshot: ProjectSnapshotBase<_>) = - - let useSimpleResolutionSwitch = "--simpleresolution" - let commandLineArgs = projectSnapshot.CommandLineOptions - let defaultFSharpBinariesDir = FSharpCheckerResultsSettings.defaultFSharpBinariesDir - let useScriptResolutionRules = projectSnapshot.UseScriptResolutionRules - - let projectReferences = - getProjectReferences projectSnapshot "ComputeTcConfigBuilder" - - // TODO: script support - let loadClosureOpt: LoadClosure option = None - - let getSwitchValue (switchString: string) = - match commandLineArgs |> List.tryFindIndex (fun s -> s.StartsWithOrdinal switchString) with - | Some idx -> Some(commandLineArgs[idx].Substring(switchString.Length)) - | _ -> None - - let sdkDirOverride = - match loadClosureOpt with - | None -> None - | Some loadClosure -> loadClosure.SdkDirOverride - - // see also fsc.fs: runFromCommandLineToImportingAssemblies(), as there are many similarities to where the PS creates a tcConfigB - let tcConfigB = - TcConfigBuilder.CreateNew( - legacyReferenceResolver, - defaultFSharpBinariesDir, - implicitIncludeDir = projectSnapshot.ProjectDirectory, - reduceMemoryUsage = ReduceMemoryFlag.Yes, - isInteractive = useScriptResolutionRules, - isInvalidationSupported = true, - defaultCopyFSharpCore = CopyFSharpCoreFlag.No, - tryGetMetadataSnapshot = tryGetMetadataSnapshot, - sdkDirOverride = sdkDirOverride, - rangeForErrors = range0 - ) + let ComputeTcConfigBuilder (projectSnapshot: ProjectSnapshot) = + node { + let useSimpleResolutionSwitch = "--simpleresolution" + let commandLineArgs = projectSnapshot.CommandLineOptions + let defaultFSharpBinariesDir = FSharpCheckerResultsSettings.defaultFSharpBinariesDir + let useScriptResolutionRules = projectSnapshot.UseScriptResolutionRules - tcConfigB.primaryAssembly <- - match loadClosureOpt with - | None -> PrimaryAssembly.Mscorlib - | Some loadClosure -> - if loadClosure.UseDesktopFramework then - PrimaryAssembly.Mscorlib - else - PrimaryAssembly.System_Runtime + let projectReferences = + getProjectReferences projectSnapshot "ComputeTcConfigBuilder" - tcConfigB.resolutionEnvironment <- (LegacyResolutionEnvironment.EditingOrCompilation true) + let getSwitchValue (switchString: string) = + match commandLineArgs |> List.tryFindIndex (fun s -> s.StartsWithOrdinal switchString) with + | Some idx -> Some(commandLineArgs[idx].Substring(switchString.Length)) + | _ -> None - tcConfigB.conditionalDefines <- - let define = - if useScriptResolutionRules then - "INTERACTIVE" - else - "COMPILED" + let useSimpleResolution = + (getSwitchValue useSimpleResolutionSwitch) |> Option.isSome - define :: tcConfigB.conditionalDefines + let! (loadClosureOpt: LoadClosure option) = + match projectSnapshot.SourceFiles, projectSnapshot.UseScriptResolutionRules with + | [ fsxFile ], true -> // assuming UseScriptResolutionRules and a single source file means we are doing this for a script + node { + let! source = fsxFile.GetSource() |> NodeCode.AwaitTask + + let! closure = + ComputeScriptClosure + fsxFile.FileName + source + defaultFSharpBinariesDir + useSimpleResolution + None + None + None + None + projectSnapshot - tcConfigB.projectReferences <- projectReferences + return (Some closure) + } + | _ -> node { return None } - tcConfigB.useSimpleResolution <- (getSwitchValue useSimpleResolutionSwitch) |> Option.isSome + let sdkDirOverride = + match loadClosureOpt with + | None -> None + | Some loadClosure -> loadClosure.SdkDirOverride + + // see also fsc.fs: runFromCommandLineToImportingAssemblies(), as there are many similarities to where the PS creates a tcConfigB + let tcConfigB = + TcConfigBuilder.CreateNew( + legacyReferenceResolver, + defaultFSharpBinariesDir, + implicitIncludeDir = projectSnapshot.ProjectDirectory, + reduceMemoryUsage = ReduceMemoryFlag.Yes, + isInteractive = useScriptResolutionRules, + isInvalidationSupported = true, + defaultCopyFSharpCore = CopyFSharpCoreFlag.No, + tryGetMetadataSnapshot = tryGetMetadataSnapshot, + sdkDirOverride = sdkDirOverride, + rangeForErrors = range0 + ) - // Apply command-line arguments and collect more source files if they are in the arguments - let sourceFilesNew = - ApplyCommandLineArgs(tcConfigB, projectSnapshot.SourceFileNames, commandLineArgs) + tcConfigB.primaryAssembly <- + match loadClosureOpt with + | None -> PrimaryAssembly.Mscorlib + | Some loadClosure -> + if loadClosure.UseDesktopFramework then + PrimaryAssembly.Mscorlib + else + PrimaryAssembly.System_Runtime - // Never open PDB files for the language service, even if --standalone is specified - tcConfigB.openDebugInformationForLaterStaticLinking <- false + tcConfigB.resolutionEnvironment <- (LegacyResolutionEnvironment.EditingOrCompilation true) - tcConfigB.xmlDocInfoLoader <- - { new IXmlDocumentationInfoLoader with - /// Try to load xml documentation associated with an assembly by the same file path with the extension ".xml". - member _.TryLoad(assemblyFileName) = - let xmlFileName = Path.ChangeExtension(assemblyFileName, ".xml") + tcConfigB.conditionalDefines <- + let define = + if useScriptResolutionRules then + "INTERACTIVE" + else + "COMPILED" - // REVIEW: File IO - Will eventually need to change this to use a file system interface of some sort. - XmlDocumentationInfo.TryCreateFromFile(xmlFileName) - } - |> Some + define :: tcConfigB.conditionalDefines - tcConfigB.parallelReferenceResolution <- parallelReferenceResolution - tcConfigB.captureIdentifiersWhenParsing <- captureIdentifiersWhenParsing + tcConfigB.projectReferences <- projectReferences - tcConfigB, sourceFilesNew, loadClosureOpt + tcConfigB.useSimpleResolution <- useSimpleResolution + + // Apply command-line arguments and collect more source files if they are in the arguments + let sourceFilesNew = + ApplyCommandLineArgs(tcConfigB, projectSnapshot.SourceFileNames, commandLineArgs) + + // Never open PDB files for the language service, even if --standalone is specified + tcConfigB.openDebugInformationForLaterStaticLinking <- false + + tcConfigB.xmlDocInfoLoader <- + { new IXmlDocumentationInfoLoader with + /// Try to load xml documentation associated with an assembly by the same file path with the extension ".xml". + member _.TryLoad(assemblyFileName) = + let xmlFileName = Path.ChangeExtension(assemblyFileName, ".xml") + + // REVIEW: File IO - Will eventually need to change this to use a file system interface of some sort. + XmlDocumentationInfo.TryCreateFromFile(xmlFileName) + } + |> Some + + tcConfigB.parallelReferenceResolution <- parallelReferenceResolution + tcConfigB.captureIdentifiersWhenParsing <- captureIdentifiersWhenParsing + + return tcConfigB, sourceFilesNew, loadClosureOpt + } let mutable BootstrapInfoIdCounter = 0 @@ -746,7 +818,7 @@ type internal TransparentCompiler let computeBootstrapInfoInner (projectSnapshot: ProjectSnapshot) = node { - let tcConfigB, sourceFiles, loadClosureOpt = ComputeTcConfigBuilder projectSnapshot + let! tcConfigB, sourceFiles, loadClosureOpt = ComputeTcConfigBuilder projectSnapshot // If this is a builder for a script, re-apply the settings inferred from the // script and its load closure to the configuration. @@ -1442,7 +1514,17 @@ type internal TransparentCompiler let tcDiagnostics = [| yield! extraDiagnostics; yield! tcDiagnostics |] - let loadClosure = None // TODO: script support + let! loadClosure = + ComputeScriptClosure + fileName + file.Source + tcConfig.fsharpBinariesDir + tcConfig.useSimpleResolution + (Some tcConfig.useFsiAuxLib) + (Some tcConfig.useSdkRefs) + tcConfig.sdkDirOverride + (Some tcConfig.assumeDotNetFramework) + projectSnapshot let typedResults = FSharpCheckFileResults.Make( @@ -1465,7 +1547,7 @@ type internal TransparentCompiler tcResolutions, tcSymbolUses, tcEnv.NameEnv, - loadClosure, + Some loadClosure, checkedImplFileOpt, tcOpenDeclarations ) @@ -1799,7 +1881,7 @@ type internal TransparentCompiler // Activity.start "ParseFile" [| Activity.Tags.fileName, fileName |> Path.GetFileName |] // TODO: might need to deal with exceptions here: - let tcConfigB, sourceFileNames, _ = ComputeTcConfigBuilder projectSnapshot + let! tcConfigB, sourceFileNames, _ = ComputeTcConfigBuilder projectSnapshot let tcConfig = TcConfig.Create(tcConfigB, validate = true) diff --git a/src/Compiler/Service/TransparentCompiler.fsi b/src/Compiler/Service/TransparentCompiler.fsi index 00167ccc67f..14562f34f15 100644 --- a/src/Compiler/Service/TransparentCompiler.fsi +++ b/src/Compiler/Service/TransparentCompiler.fsi @@ -132,6 +132,8 @@ type internal CompilerCaches = member TcIntermediate: AsyncMemoize<(string * (string * string)), (string * int), TcIntermediate> + member ScriptClosure: AsyncMemoize<(string * (string * string)), string, LoadClosure> + member TcLastFile: AsyncMemoizeDisabled type internal TransparentCompiler = diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs index 5ff288185c4..664b79d4e0e 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs @@ -842,3 +842,57 @@ let ``TypeCheck last file in project with transparent compiler`` useTransparentC clearCache checkFile lastFile expectOk } + +[] +let ``LoadClosure for script is computed once`` () = + let project = SyntheticProject.CreateForScript( + sourceFile "First" []) + + let cacheEvents = ConcurrentQueue() + + ProjectWorkflowBuilder(project, useTransparentCompiler = true) { + withChecker (fun checker -> + async { + do! Async.Sleep 50 // wait for events from initial project check + checker.Caches.ScriptClosure.OnEvent cacheEvents.Enqueue + }) + + checkFile "First" expectOk + } |> ignore + + let closureComputations = + cacheEvents + |> Seq.groupBy (fun (_e, (_l, (f, _p), _)) -> Path.GetFileName f) + |> Seq.map (fun (k, g) -> k, g |> Seq.map fst |> Seq.toList) + |> Map + + Assert.Empty(closureComputations) + +[] +let ``LoadClosure for script is recomputed after changes`` () = + let project = SyntheticProject.CreateForScript( + sourceFile "First" []) + + let cacheEvents = ConcurrentQueue() + + ProjectWorkflowBuilder(project, useTransparentCompiler = true) { + withChecker (fun checker -> + async { + do! Async.Sleep 50 // wait for events from initial project check + checker.Caches.ScriptClosure.OnEvent cacheEvents.Enqueue + }) + + checkFile "First" expectOk + updateFile "First" updateInternal + checkFile "First" expectOk + updateFile "First" updatePublicSurface + checkFile "First" expectOk + } |> ignore + + let closureComputations = + cacheEvents + |> Seq.groupBy (fun (_e, (_l, (f, _p), _)) -> Path.GetFileName f) + |> Seq.map (fun (k, g) -> k, g |> Seq.map fst |> Seq.toList) + |> Map + + Assert.Equal([Weakened; Requested; Started; Finished; Weakened; Requested; Started; Finished], closureComputations["FileFirst.fs"]) \ No newline at end of file diff --git a/tests/FSharp.Test.Utilities/ProjectGeneration.fs b/tests/FSharp.Test.Utilities/ProjectGeneration.fs index 144e535bccb..2236eee988d 100644 --- a/tests/FSharp.Test.Utilities/ProjectGeneration.fs +++ b/tests/FSharp.Test.Utilities/ProjectGeneration.fs @@ -240,7 +240,8 @@ type SyntheticProject = NugetReferences: Reference list FrameworkReferences: Reference list /// If set to true this project won't cause an exception if there are errors in the initial check - SkipInitialCheck: bool } + SkipInitialCheck: bool + UseScriptResolutionRules: bool } static member Create(?name: string) = let name = defaultArg name $"TestProject_{Guid.NewGuid().ToString()[..7]}" @@ -255,13 +256,17 @@ type SyntheticProject = AutoAddModules = true NugetReferences = [] FrameworkReferences = [] - SkipInitialCheck = false } + SkipInitialCheck = false + UseScriptResolutionRules = false } static member Create([] sourceFiles: SyntheticSourceFile[]) = { SyntheticProject.Create() with SourceFiles = sourceFiles |> List.ofArray } static member Create(name: string, [] sourceFiles: SyntheticSourceFile[]) = { SyntheticProject.Create(name) with SourceFiles = sourceFiles |> List.ofArray } + + static member CreateForScript(scriptFile: SyntheticSourceFile) = + { SyntheticProject.Create() with SourceFiles = [scriptFile]; UseScriptResolutionRules = true } member this.Find fileId = this.SourceFiles @@ -339,7 +344,7 @@ type SyntheticProject = [| for p in this.DependsOn do FSharpReferencedProject.FSharpReference(p.OutputFilename, p.GetProjectOptions checker) |] IsIncompleteTypeCheckEnvironment = false - UseScriptResolutionRules = false + UseScriptResolutionRules = this.UseScriptResolutionRules LoadTime = DateTime() UnresolvedReferences = None OriginalLoadReferences = []