Skip to content

Commit

Permalink
Add script support to the TransparentCompiler (#16627)
Browse files Browse the repository at this point in the history
  • Loading branch information
@dawedawe
dawedawe authored Feb 8, 2024
1 parent 93b8f0c commit ef6d5f2
Show file tree
Hide file tree
Showing 4 changed files with 222 additions and 79 deletions.
234 changes: 158 additions & 76 deletions src/Compiler/Service/TransparentCompiler.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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<ProjectIdentifier>) =
let shouldClear project = projects |> Set.contains project

Expand All @@ -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
(
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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(
Expand All @@ -1465,7 +1547,7 @@ type internal TransparentCompiler
tcResolutions,
tcSymbolUses,
tcEnv.NameEnv,
loadClosure,
Some loadClosure,
checkedImplFileOpt,
tcOpenDeclarations
)
Expand Down Expand Up @@ -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)

Expand Down
2 changes: 2 additions & 0 deletions src/Compiler/Service/TransparentCompiler.fsi
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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<obj, obj, obj>

type internal TransparentCompiler =
Expand Down
54 changes: 54 additions & 0 deletions tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -842,3 +842,57 @@ let ``TypeCheck last file in project with transparent compiler`` useTransparentC
clearCache
checkFile lastFile expectOk
}

[<Fact>]
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)

[<Fact>]
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<JobEvent list>([Weakened; Requested; Started; Finished; Weakened; Requested; Started; Finished], closureComputations["FileFirst.fs"])
Loading

0 comments on commit ef6d5f2

Please sign in to comment.