diff --git a/.github/skills/fsharp-diagnostics/PLAN_FOR_WINDOWS.md b/.github/skills/fsharp-diagnostics/PLAN_FOR_WINDOWS.md new file mode 100644 index 00000000000..123c9d65d19 --- /dev/null +++ b/.github/skills/fsharp-diagnostics/PLAN_FOR_WINDOWS.md @@ -0,0 +1,100 @@ +# Windows Support Plan for FastBuildFromCache + +## Strategy + +Use **Unix Domain Sockets (UDS) on all platforms**, including Windows. +Windows 10 1803+ supports `AF_UNIX`. .NET's `UnixDomainSocketEndPoint` works cross-platform since .NET Core 3.0+. +This keeps the server transport code unchanged — the work is a new PowerShell client script and minor path fixes. + +**Why not Named Pipes?** Would require a transport abstraction in the server (different accept-loop lifecycle for `NamedPipeServerStream` vs `Socket`), doubling transport code for no benefit when UDS works. + +**Why not a .NET client tool?** Chicken-and-egg: the client must exist before FCS builds, but would itself need building first. Also adds ~150ms JIT startup per invocation. + +**Prerequisite:** `pwsh` (PowerShell 7+). Windows PowerShell 5.1 lacks `UnixDomainSocketEndPoint`. The MSBuild targets use `ContinueOnError="true"`, so missing `pwsh` gracefully falls back to normal `fsc`. + +--- + +## Changes + +### 1. `eng/targets/FastBuildFromCache.targets` + +Replace hardcoded `bash` with OS-conditional properties and a single ``: + +```xml +<_FastBuildScript Condition="'$(OS)'!='Windows_NT'">...get-fsharp-errors.sh +<_FastBuildScript Condition="'$(OS)'=='Windows_NT'">...get-fsharp-errors.ps1 +<_FastBuildInterpreter Condition="'$(OS)'!='Windows_NT'">bash +<_FastBuildInterpreter Condition="'$(OS)'=='Windows_NT'">pwsh -NoProfile -File +``` + +Single Exec: `Command="$(_FastBuildInterpreter) "$(_FastBuildScript)" ..."` + +### 2. NEW: `scripts/get-fsharp-errors.ps1` + +PowerShell Core port of `get-fsharp-errors.sh` (~100-120 lines). Key translations: + +| Bash | PowerShell | +|------|------------| +| `shasum -a 256` | `[System.Security.Cryptography.SHA256]::HashData()` | +| `nc -U "$sock"` | `[System.Net.Sockets.Socket]` + `[UnixDomainSocketEndPoint]` + `NetworkStream` + `StreamReader/Writer` | +| `nohup dotnet run ... &` | `Start-Process dotnet -ArgumentList ... -NoNewWindow` | +| `[ -S "$sock" ]` | `Test-Path $sock` | +| `set -euo pipefail` | `$ErrorActionPreference = 'Stop'; Set-StrictMode -Version Latest` | +| `$HOME/.fsharp-diag` | `Join-Path $env:USERPROFILE '.fsharp-diag'` | + +Same JSON protocol, same command-line interface (`--compile`, `--parse-only`, etc.). + +### 3. `server/Server.fs` + +Two one-line fixes: + +- **`File.SetUnixFileMode`** (throws `PlatformNotSupportedException` on Windows): + ```fsharp + if not (OperatingSystem.IsWindows()) then File.SetUnixFileMode(socketPath, ...) + ``` + +- **`TrimEnd('/')`** (doesn't strip `\` on Windows paths): + ```fsharp + config.RepoRoot.TrimEnd('/', '\\') + "/" + ``` + +### 4. `server/ProjectRouting.fs` + +- `TrimEnd('/')` → `TrimEnd('/', '\\')` +- `StringComparison.Ordinal` → `StringComparison.OrdinalIgnoreCase` for path prefix checks +- Normalize relative path: `.Replace('\\', '/')` before pattern matching against `"tests/"`, `"src/"` etc. + +### 5. `server/DiagnosticsFormatter.fs` + +- `TrimEnd('/')` → `TrimEnd('/', '\\')` +- `StringComparison.OrdinalIgnoreCase` for `path.StartsWith(root)` + +--- + +## Critical: Path Normalization Before Hashing + +The socket path is derived from `SHA256(repoRoot)`. Client and server **must hash the exact same string** or they'll look for different sockets. + +Problem: `git rev-parse --show-toplevel` returns `C:/Users/foo/fsharp` on Windows (forward slashes), but .NET's `Directory.GetCurrentDirectory()` returns `C:\Users\foo\fsharp` (backslashes). + +**Rule:** Before hashing, normalize to: forward slashes, no trailing separator. +Apply this in both the PS1 script and `deriveSocketPath` in Server.fs. + +--- + +## What Does NOT Need Changing + +- **Socket transport in Server.fs** — `Socket(AddressFamily.Unix)` + `UnixDomainSocketEndPoint` works on Windows +- **FileSystemWatcher** — cross-platform in .NET +- **FSharpDiagServer.fsproj** — `net10.0` SDK project, fully cross-platform +- **Program.fs** — no OS-specific code +- **All product code** (`service.fs`, `FSharpCheckerResults.fs`, `CompilerImports.fs`, `fsc.fs`) — already cross-platform + +## Testing Checklist + +- [ ] `pwsh` can connect to server via UDS on Windows +- [ ] Server spawns correctly via `Start-Process` from PS1 +- [ ] Socket path matches between PS1 client and server (hash normalization) +- [ ] `dotnet test ... /p:FastBuildFromCache=true` works end-to-end on Windows +- [ ] Graceful fallback when `pwsh` is not installed +- [ ] No-change build is a no-op (MSBuild incremental skip works on Windows) diff --git a/.github/skills/fsharp-diagnostics/SKILL.md b/.github/skills/fsharp-diagnostics/SKILL.md index 76b1b2808c2..92838f8bdd0 100644 --- a/.github/skills/fsharp-diagnostics/SKILL.md +++ b/.github/skills/fsharp-diagnostics/SKILL.md @@ -13,36 +13,32 @@ description: "After modifying any F# file, use this to get quick parse errors an GetErrors() { "$(git rev-parse --show-toplevel)/.github/skills/fsharp-diagnostics/scripts/get-fsharp-errors.sh" "$@"; } ``` -## Parse first, typecheck second +## Rules -```bash -GetErrors --parse-only src/Compiler/Checking/CheckBasics.fs -``` -If errors → fix syntax. Do NOT typecheck until parse is clean. -```bash -GetErrors src/Compiler/Checking/CheckBasics.fs -``` +1. **After every edit** to a `src/Compiler/*.fs` file → typecheck it before proceeding. This catches errors in ~2s vs ~35s for a full build. Do NOT attempt `dotnet build` or `dotnet test` until the file typechecks clean. +2. **Use `--find-refs` instead of grep** for finding usages of a symbol (function, type, member, field). Returns semantically resolved references — no false positives from comments, strings, or similarly-named symbols. +3. **Use `--type-hints` to read code blocks** — F# infers most types, so bindings like `env`, `state`, `x` are opaque without it. + - ⚠️ Output has `// (name: Type)` annotations. These are **read-only overlays**. When editing, use `view` to get the real unannotated source. +4. **Parse first, typecheck second** — fix `--parse-only` errors before running a full typecheck. -## Find references for a single symbol (line 1-based, col 0-based) +## Commands -Before renaming or to understand call sites: ```bash -GetErrors --find-refs src/Compiler/Checking/CheckBasics.fs 30 5 +GetErrors --parse-only src/Compiler/path/File.fs # parse errors only +GetErrors src/Compiler/path/File.fs # full typecheck +GetErrors --find-refs src/Compiler/path/File.fs 30 5 # references (line 1-based, col 0-based) +GetErrors --type-hints src/Compiler/path/File.fs 50 60 # annotated code (line range, 1-based) +GetErrors --check-project # typecheck entire project +GetErrors --ping # server alive? +GetErrors --shutdown # stop server ``` -## Type hints for a range selection (begin and end line numbers, 1-based) - -To see inferred types as inline `// (name: Type)` comments: -```bash -GetErrors --type-hints src/Compiler/TypedTree/TypedTreeOps.fs 1028 1032 -``` +## Cached test runs -## Other +No separate `dotnet build` of FSharp.Compiler.Service needed — `dotnet test` builds all dependencies automatically. ```bash -GetErrors --check-project # typecheck entire project -GetErrors --ping -GetErrors --shutdown +dotnet test tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj -c Release /p:FastBuildFromCache=true ``` First call starts server (~70s cold start, set initial_wait=600). Auto-shuts down after 4h idle. ~3 GB RAM. diff --git a/.github/skills/fsharp-diagnostics/scripts/get-fsharp-errors.sh b/.github/skills/fsharp-diagnostics/scripts/get-fsharp-errors.sh index 824c37f7628..731abcf30ca 100755 --- a/.github/skills/fsharp-diagnostics/scripts/get-fsharp-errors.sh +++ b/.github/skills/fsharp-diagnostics/scripts/get-fsharp-errors.sh @@ -5,6 +5,7 @@ set -euo pipefail # Usage: # get-fsharp-errors.sh [--parse-only] # get-fsharp-errors.sh --check-project +# get-fsharp-errors.sh --compile # get-fsharp-errors.sh --ping # get-fsharp-errors.sh --shutdown @@ -104,9 +105,19 @@ case "${1:-}" in ensure_server "$REPO_ROOT" "$SOCK_PATH" send_request "$SOCK_PATH" "{\"command\":\"typeHints\",\"file\":\"$FILE\",\"startLine\":$START_LINE,\"endLine\":$END_LINE}" ;; + --compile) + shift + PROJECT="$1" + OUTPUT="$2" + ensure_server "$REPO_ROOT" "$SOCK_PATH" + RESPONSE=$(send_request "$SOCK_PATH" "{\"command\":\"compile\",\"project\":\"$PROJECT\",\"output\":\"$OUTPUT\"}") + echo "$RESPONSE" + case "$RESPONSE" in ERROR*) exit 1 ;; esac + ;; -*) echo "Usage: get-fsharp-errors [--parse-only] " >&2 echo " get-fsharp-errors --check-project " >&2 + echo " get-fsharp-errors --compile " >&2 echo " get-fsharp-errors --ping | --shutdown" >&2 exit 1 ;; diff --git a/.github/skills/fsharp-diagnostics/server/DesignTimeBuild.fs b/.github/skills/fsharp-diagnostics/server/DesignTimeBuild.fs index 1e8d4596e0c..c4ef61816db 100644 --- a/.github/skills/fsharp-diagnostics/server/DesignTimeBuild.fs +++ b/.github/skills/fsharp-diagnostics/server/DesignTimeBuild.fs @@ -5,7 +5,9 @@ open System.Diagnostics open System.IO open System.Text.Json -type DtbResult = { CompilerArgs: string array } +type DtbResult = + { CompilerArgs: string array + IntermediateOutputPath: string } type DtbConfig = { @@ -27,15 +29,49 @@ let run (fsprojPath: string) (config: DtbConfig) = |> Option.defaultValue "" let projDir = Path.GetDirectoryName(fsprojPath) + let projName = Path.GetFileNameWithoutExtension(fsprojPath) - // /t:Build runs BeforeBuild (generates buildproperties.fs via CompileBefore). - // DesignTimeBuild=true skips dependency projects. - // SkipCompilerExecution=true + ProvideCommandLineArgs=true populates FscCommandLineArgs without compiling. + // Query IntermediateOutputPath to find and delete the intermediate assembly, + // defeating MSBuild's up-to-date check so CoreCompile actually runs. + let iopPsi = + ProcessStartInfo( + FileName = "dotnet", + Arguments = + $"msbuild \"{fsprojPath}\" /p:BUILDING_USING_DOTNET=true /p:Configuration={config.Configuration}{tfmArg} /nologo /v:q /getProperty:IntermediateOutputPath", + RedirectStandardOutput = true, + RedirectStandardError = true, + UseShellExecute = false, + WorkingDirectory = projDir + ) + use iopProc = Process.Start(iopPsi) + let! iopOut = iopProc.StandardOutput.ReadToEndAsync() |> Async.AwaitTask + do! iopProc.WaitForExitAsync() |> Async.AwaitTask + + let iopOut = iopOut.Trim() + // Handle both plain path and JSON output from /getProperty + let intermediateDir = + if iopOut.StartsWith("{") then + try + let doc = JsonDocument.Parse(iopOut) + doc.RootElement.GetProperty("Properties").GetProperty("IntermediateOutputPath").GetString() + with _ -> "" + else iopOut + let intermediateDir = + if Path.IsPathRooted(intermediateDir) then intermediateDir + elif intermediateDir.Length > 0 then Path.Combine(projDir, intermediateDir) + else "" + if intermediateDir.Length > 0 then + let intermediateDll = Path.Combine(intermediateDir, projName + ".dll") + if File.Exists(intermediateDll) then + try File.Delete(intermediateDll) with _ -> () + + // /t:CoreCompile + SkipCompilerExecution + ProvideCommandLineArgs populates FscCommandLineArgs. + // BuildProjectReferences=false avoids rebuilding dependencies. let psi = ProcessStartInfo( FileName = "dotnet", Arguments = - $"msbuild \"{fsprojPath}\" /t:Build /p:DesignTimeBuild=true /p:SkipCompilerExecution=true /p:ProvideCommandLineArgs=true /p:CopyBuildOutputToOutputDirectory=false /p:CopyOutputSymbolsToOutputDirectory=false /p:BUILDING_USING_DOTNET=true /p:Configuration={config.Configuration}{tfmArg} /nologo /v:q /getItem:FscCommandLineArgs", + $"msbuild \"{fsprojPath}\" /t:CoreCompile /p:SkipCompilerExecution=true /p:ProvideCommandLineArgs=true /p:CopyBuildOutputToOutputDirectory=false /p:CopyOutputSymbolsToOutputDirectory=false /p:BUILDING_USING_DOTNET=true /p:BuildProjectReferences=false /p:Configuration={config.Configuration}{tfmArg} /nologo /v:q \"/getItem:FscCommandLineArgs;ReferencePath\"", RedirectStandardOutput = true, RedirectStandardError = true, UseShellExecute = false, @@ -51,7 +87,6 @@ let run (fsprojPath: string) (config: DtbConfig) = return Error $"DTB failed (exit {proc.ExitCode}): {stderr}" else try - // MSBuild may emit warnings before the JSON; find the JSON start let jsonStart = stdout.IndexOf('{') if jsonStart < 0 then @@ -65,7 +100,22 @@ let run (fsprojPath: string) (config: DtbConfig) = |> Seq.map (fun e -> e.GetProperty("Identity").GetString()) |> Seq.toArray - return Ok { CompilerArgs = args } + let refs = + match items.TryGetProperty("ReferencePath") with + | true, refItems -> + refItems.EnumerateArray() + |> Seq.map (fun e -> + let path = e.GetProperty("Identity").GetString() + "-r:" + path) + |> Seq.toArray + | false, _ -> [||] + + let combined = Array.append args refs + + if args.Length = 0 then + return Error "DTB returned empty FscCommandLineArgs (CoreCompile was skipped)" + else + return Ok { CompilerArgs = combined; IntermediateOutputPath = intermediateDir } with ex -> return Error $"Failed to parse DTB output: {ex.Message}" } diff --git a/.github/skills/fsharp-diagnostics/server/Directory.Build.props b/.github/skills/fsharp-diagnostics/server/Directory.Build.props index 5a08e96c89f..aee071495f5 100644 --- a/.github/skills/fsharp-diagnostics/server/Directory.Build.props +++ b/.github/skills/fsharp-diagnostics/server/Directory.Build.props @@ -5,5 +5,8 @@ false $(MSBuildThisFileDirectory)../../../../.tools/fsharp-diag/bin/ $(MSBuildThisFileDirectory)../../../../.tools/fsharp-diag/obj/ + true + true + $(MSBuildThisFileDirectory)../../../../buildtools/keys/MSFT.snk diff --git a/.github/skills/fsharp-diagnostics/server/FSharpDiagServer.fsproj b/.github/skills/fsharp-diagnostics/server/FSharpDiagServer.fsproj index 7f2b01885fa..163b3e9d2c3 100644 --- a/.github/skills/fsharp-diagnostics/server/FSharpDiagServer.fsproj +++ b/.github/skills/fsharp-diagnostics/server/FSharpDiagServer.fsproj @@ -3,16 +3,41 @@ Exe net10.0 + + <_DiagServerRepoRoot>$([MSBuild]::NormalizeDirectory('$(MSBuildThisFileDirectory)', '..', '..', '..', '..')) + + <_ReleaseFcsPath>$(_DiagServerRepoRoot)artifacts/bin/FSharp.Compiler.Service/Release/net10.0/FSharp.Compiler.Service.dll + + <_ProtoFcsPath>$(_DiagServerRepoRoot)artifacts/Bootstrap/fsc/FSharp.Compiler.Service.dll - + + + + $(_ReleaseFcsPath) + + + + + + + $(_ProtoFcsPath) + + + + + + + + + diff --git a/.github/skills/fsharp-diagnostics/server/ProjectManager.fs b/.github/skills/fsharp-diagnostics/server/ProjectManager.fs index 28b64b91544..eb66b72a429 100644 --- a/.github/skills/fsharp-diagnostics/server/ProjectManager.fs +++ b/.github/skills/fsharp-diagnostics/server/ProjectManager.fs @@ -1,29 +1,29 @@ module FSharpDiagServer.ProjectManager +open System.Collections.Concurrent open System.IO open FSharp.Compiler.CodeAnalysis type ProjectManager(checker: FSharpChecker) = - let mutable cached: (System.DateTime * FSharpProjectOptions) option = None - let gate = obj () + let cache = ConcurrentDictionary() let isSourceFile (s: string) = not (s.StartsWith("-")) && (s.EndsWith(".fs", System.StringComparison.OrdinalIgnoreCase) || s.EndsWith(".fsi", System.StringComparison.OrdinalIgnoreCase)) + let normalize (path: string) = Path.GetFullPath(path) + member _.ResolveProjectOptions(fsprojPath: string) = async { - let fsprojMtime = File.GetLastWriteTimeUtc(fsprojPath) + let key = normalize fsprojPath + let fsprojMtime = File.GetLastWriteTimeUtc(key) let current = - lock gate (fun () -> - match cached with - | Some(mtime, opts) when mtime = fsprojMtime -> Some opts - | Some _ -> - cached <- None - None - | None -> None) + match cache.TryGetValue(key) with + | true, (mtime, opts) when mtime = fsprojMtime -> Some opts + | true, _ -> cache.TryRemove(key) |> ignore; None + | false, _ -> None match current with | Some opts -> return Ok opts @@ -33,7 +33,7 @@ type ProjectManager(checker: FSharpChecker) = match dtbResult with | Error msg -> return Error msg | Ok dtb -> - let projDir = Path.GetDirectoryName(fsprojPath) + let projDir = Path.GetDirectoryName(key) let resolve (s: string) = if Path.IsPathRooted(s) then @@ -45,11 +45,62 @@ type ProjectManager(checker: FSharpChecker) = dtb.CompilerArgs |> Array.map (fun a -> if isSourceFile a then resolve a else a) let sourceFiles = resolvedArgs |> Array.filter isSourceFile + + // MSBuild auto-generates AssemblyInfo.fs and buildproperties.fs in the + // intermediate output. These are added to @(Compile) but NOT to + // FscCommandLineArgs. Include them if they exist and aren't already present. + let extraGeneratedFiles = + if dtb.IntermediateOutputPath.Length > 0 then + let projName = Path.GetFileNameWithoutExtension(key) + [| Path.Combine(dtb.IntermediateOutputPath, projName + ".AssemblyInfo.fs") + Path.Combine(dtb.IntermediateOutputPath, "buildproperties.fs") |] + |> Array.filter (fun f -> + File.Exists(f) && + let full = Path.GetFullPath(f) + not (sourceFiles |> Array.exists (fun s -> Path.GetFullPath(s) = full))) + else [||] + let sourceFiles = Array.append sourceFiles extraGeneratedFiles + + // Generated string resource files (FSComp, FSIstrings, UtilsStrings) must come + // before source files that reference them. FscCommandLineArgs doesn't preserve + // the CompileBefore ordering from MSBuild. + let isGeneratedFirst (s: string) = + let name = System.IO.Path.GetFileNameWithoutExtension(s) + name = "FSComp" || name = "FSIstrings" || name = "UtilsStrings" + || name = "buildproperties" + let orderedSources = + Array.append + (sourceFiles |> Array.filter isGeneratedFirst) + (sourceFiles |> Array.filter (not << isGeneratedFirst)) let flagsOnly = resolvedArgs |> Array.filter (not << isSourceFile) - let opts = checker.GetProjectOptionsFromCommandLineArgs(fsprojPath, flagsOnly) - let options = { opts with SourceFiles = sourceFiles } - lock gate (fun () -> cached <- Some(fsprojMtime, options)) + // Add --nowin32manifest: default.win32manifest may not exist on all platforms + let flagsOnly = Array.append flagsOnly [| "--nowin32manifest" |] + // Embed pre-compiled .resources files from intermediate output. + // These are generated by CoreResGen from .resx files (which come from + // FSComp.txt, FSIstrings.txt, etc.). They only change when the .txt + // source files change, so reusing them from the intermediate directory is safe. + let resourceFlags = + if dtb.IntermediateOutputPath.Length > 0 then + System.IO.Directory.GetFiles(dtb.IntermediateOutputPath, "*.resources") + |> Array.map (fun r -> "--resource:" + r) + else [||] + let flagsOnly = Array.append flagsOnly resourceFlags + let opts = checker.GetProjectOptionsFromCommandLineArgs(key, flagsOnly) + let options = { opts with SourceFiles = orderedSources } + cache.[key] <- (fsprojMtime, options) return Ok options } - member _.Invalidate() = lock gate (fun () -> cached <- None) + member _.Invalidate(?fsprojPath: string) = + match fsprojPath with + | Some p -> cache.TryRemove(normalize p) |> ignore + | None -> cache.Clear() + + member internal _.CacheCount = cache.Count + + member internal _.HasCachedProject(fsprojPath: string) = + cache.ContainsKey(normalize fsprojPath) + + member internal _.InjectTestEntry(fsprojPath: string, options: FSharpProjectOptions) = + let key = normalize fsprojPath + cache.[key] <- (System.DateTime.MinValue, options) diff --git a/.github/skills/fsharp-diagnostics/server/ProjectRouting.fs b/.github/skills/fsharp-diagnostics/server/ProjectRouting.fs new file mode 100644 index 00000000000..38a60afd2f6 --- /dev/null +++ b/.github/skills/fsharp-diagnostics/server/ProjectRouting.fs @@ -0,0 +1,19 @@ +module FSharpDiagServer.ProjectRouting + +open System.IO + +/// Maps a source file path to the fsproj that owns it. +/// Falls back to FSharp.Compiler.Service for any unrecognized path. +let resolveProject (repoRoot: string) (filePath: string) = + let root = repoRoot.TrimEnd('/') + "/" + + let rel = + if filePath.StartsWith(root, System.StringComparison.Ordinal) then + filePath.Substring(root.Length) + else + filePath + + if rel.StartsWith("tests/FSharp.Compiler.ComponentTests/", System.StringComparison.Ordinal) then + Path.Combine(repoRoot, "tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj") + else + Path.Combine(repoRoot, "src/Compiler/FSharp.Compiler.Service.fsproj") diff --git a/.github/skills/fsharp-diagnostics/server/Server.fs b/.github/skills/fsharp-diagnostics/server/Server.fs index e45a9b9ad9e..983599d8e2f 100644 --- a/.github/skills/fsharp-diagnostics/server/Server.fs +++ b/.github/skills/fsharp-diagnostics/server/Server.fs @@ -38,10 +38,6 @@ let startServer (config: ServerConfig) = async { let socketPath = deriveSocketPath config.RepoRoot let metaPath = deriveMetaPath config.RepoRoot - - let fsproj = - Path.Combine(config.RepoRoot, "src/Compiler/FSharp.Compiler.Service.fsproj") - Directory.CreateDirectory(sockDir) |> ignore if File.Exists(socketPath) then @@ -54,7 +50,11 @@ let startServer (config: ServerConfig) = let mutable lastActivity = DateTimeOffset.UtcNow let cts = new CancellationTokenSource() - let getOptions () = + // Enable --times output from F# compiler phases (Activity-based profiling) + use _timesListener = FSharp.Compiler.Diagnostics.Activity.Profiling.addConsoleListener () + + let getOptions (filePath: string) = + let fsproj = ProjectRouting.resolveProject config.RepoRoot filePath projectMgr.ResolveProjectOptions(fsproj) let handleRequest (json: string) = @@ -74,20 +74,16 @@ let startServer (config: ServerConfig) = if not (File.Exists file) then return $"""{{ "error":"file not found: {file}" }}""" else - let sourceText = SourceText.ofString (File.ReadAllText(file)) - // Use project options for correct --langversion, --define etc - let! optionsResult = getOptions () - - let parsingArgs = - match optionsResult with - | Ok o -> o.OtherOptions |> Array.toList - | _ -> [] - - let parsingOpts, _ = - checker.GetParsingOptionsFromCommandLineArgs(file :: parsingArgs) - - let! parseResults = checker.ParseFile(file, sourceText, parsingOpts) - return DiagnosticsFormatter.formatFile parseResults.Diagnostics + let sourceText = SourceText.ofString (File.ReadAllText(file)) + // Use project options for correct --langversion, --define etc + let! optionsResult = getOptions file + let parsingArgs = + match optionsResult with + | Ok o -> o.OtherOptions |> Array.toList + | _ -> [] + let parsingOpts, _ = checker.GetParsingOptionsFromCommandLineArgs(file :: parsingArgs) + let! parseResults = checker.ParseFile(file, sourceText, parsingOpts) + return DiagnosticsFormatter.formatFile parseResults.Diagnostics | "check" -> let file = Path.GetFullPath(doc.RootElement.GetProperty("file").GetString()) @@ -95,26 +91,33 @@ let startServer (config: ServerConfig) = if not (File.Exists file) then return $"""{{ "error":"file not found: {file}" }}""" else - let! optionsResult = getOptions () - - match optionsResult with - | Error msg -> return $"ERROR: {msg}" - | Ok options -> - let sourceText = SourceText.ofString (File.ReadAllText(file)) - let version = File.GetLastWriteTimeUtc(file).Ticks |> int - let! parseResults, checkAnswer = checker.ParseAndCheckFileInProject(file, version, sourceText, options) - - let diags = - match checkAnswer with - | FSharpCheckFileAnswer.Succeeded r -> Array.append parseResults.Diagnostics r.Diagnostics - | FSharpCheckFileAnswer.Aborted -> parseResults.Diagnostics - |> Array.distinctBy (fun d -> d.StartLine, d.Start.Column, d.ErrorNumberText) - - return DiagnosticsFormatter.formatFile diags + let! optionsResult = getOptions file + match optionsResult with + | Error msg -> + return $"ERROR: {msg}" + | Ok options -> + let sourceText = SourceText.ofString (File.ReadAllText(file)) + let version = File.GetLastWriteTimeUtc(file).Ticks |> int + let! parseResults, checkAnswer = checker.ParseAndCheckFileInProject(file, version, sourceText, options) + let diags = + match checkAnswer with + | FSharpCheckFileAnswer.Succeeded r -> + if parseResults.Diagnostics.Length = 0 then r.Diagnostics + elif r.Diagnostics.Length = 0 then parseResults.Diagnostics + else Array.append parseResults.Diagnostics r.Diagnostics + | FSharpCheckFileAnswer.Aborted -> parseResults.Diagnostics + |> Array.distinctBy (fun d -> d.StartLine, d.Start.Column, d.ErrorNumberText) + return DiagnosticsFormatter.formatFile diags | "checkProject" -> - let! optionsResult = getOptions () - + let project = + match doc.RootElement.TryGetProperty("project") with + | true, p -> + let raw = p.GetString() + if Path.IsPathRooted(raw) then raw + else Path.GetFullPath(Path.Combine(config.RepoRoot, raw)) + | false, _ -> Path.Combine(config.RepoRoot, "src/Compiler/FSharp.Compiler.Service.fsproj") + let! optionsResult = projectMgr.ResolveProjectOptions(project) match optionsResult with | Error msg -> return $"ERROR: {msg}" | Ok options -> @@ -129,79 +132,51 @@ let startServer (config: ServerConfig) = if not (File.Exists file) then return $"ERROR: file not found: {file}" else - let! optionsResult = getOptions () - - match optionsResult with - | Error msg -> return $"ERROR: {msg}" - | Ok options -> - let sourceText = SourceText.ofString (File.ReadAllText(file)) - let version = File.GetLastWriteTimeUtc(file).Ticks |> int - let! _, checkAnswer = checker.ParseAndCheckFileInProject(file, version, sourceText, options) - - match checkAnswer with - | FSharpCheckFileAnswer.Aborted -> return "ERROR: check aborted" - | FSharpCheckFileAnswer.Succeeded checkResults -> - let sourceLines = File.ReadAllLines file - let lineText = sourceLines.[line - 1] - - let isIdChar c = - Char.IsLetterOrDigit(c) || c = '_' || c = '\'' - - let mutable endCol = col - - while endCol < lineText.Length && isIdChar lineText.[endCol] do - endCol <- endCol + 1 - - let mutable startCol = col - - while startCol > 0 && isIdChar lineText.[startCol - 1] do - startCol <- startCol - 1 - - let name = lineText.[startCol .. endCol - 1] - - if name.Length = 0 then - return "ERROR: no identifier at that position" - else - match checkResults.GetSymbolUseAtLocation(line, endCol, lineText, [ name ]) with - | None -> return $"ERROR: no symbol found for '{name}' at {line}:{col}" - | Some symbolUse -> - let! projectResults = checker.ParseAndCheckProject(options) - // Collect related symbols: for DU types, also search union cases - let targetNames = ResizeArray() - targetNames.Add(symbolUse.Symbol.FullName) - - match symbolUse.Symbol with - | :? FSharpEntity as ent when ent.IsFSharpUnion -> - for uc in ent.UnionCases do - targetNames.Add(uc.FullName) - | _ -> () - - let uses = - projectResults.GetAllUsesOfAllSymbols() - |> Array.filter (fun u -> targetNames.Contains(u.Symbol.FullName)) - - let root = config.RepoRoot.TrimEnd('/') + "/" - - let rel (p: string) = - if p.StartsWith(root) then p.Substring(root.Length) else p - - let lines = - uses - |> Array.map (fun u -> - let kind = - if u.IsFromDefinition then "DEF" - elif u.IsFromType then "TYPE" - else "USE" - - $"{kind} {rel u.Range.FileName}:{u.Range.StartLine},{u.Range.StartColumn}") - |> Array.distinct - - let sym = symbolUse.Symbol - - let header = - $"Symbol: {sym.DisplayName} ({sym.GetType().Name}) — {lines.Length} references" - - return header + "\n" + (lines |> String.concat "\n") + let! optionsResult = getOptions file + match optionsResult with + | Error msg -> return $"ERROR: {msg}" + | Ok options -> + let sourceText = SourceText.ofString (File.ReadAllText(file)) + let version = File.GetLastWriteTimeUtc(file).Ticks |> int + let! _, checkAnswer = checker.ParseAndCheckFileInProject(file, version, sourceText, options) + match checkAnswer with + | FSharpCheckFileAnswer.Aborted -> return "ERROR: check aborted" + | FSharpCheckFileAnswer.Succeeded checkResults -> + let sourceLines = File.ReadAllLines file + let lineText = sourceLines.[line - 1] + let isIdChar c = Char.IsLetterOrDigit(c) || c = '_' || c = '\'' + let mutable endCol = col + while endCol < lineText.Length && isIdChar lineText.[endCol] do endCol <- endCol + 1 + let mutable startCol = col + while startCol > 0 && isIdChar lineText.[startCol - 1] do startCol <- startCol - 1 + let name = lineText.[startCol..endCol - 1] + if name.Length = 0 then + return "ERROR: no identifier at that position" + else + match checkResults.GetSymbolUseAtLocation(line, endCol, lineText, [name]) with + | None -> return $"ERROR: no symbol found for '{name}' at {line}:{col}" + | Some symbolUse -> + let! projectResults = checker.ParseAndCheckProject(options) + // Collect related symbols: for DU types, also search union cases + let targetNames = System.Collections.Generic.HashSet() + targetNames.Add(symbolUse.Symbol.FullName) |> ignore + match symbolUse.Symbol with + | :? FSharpEntity as ent when ent.IsFSharpUnion -> + for uc in ent.UnionCases do targetNames.Add(uc.FullName) |> ignore + | _ -> () + let uses = + projectResults.GetAllUsesOfAllSymbols() + |> Array.filter (fun u -> targetNames.Contains(u.Symbol.FullName)) + let root = config.RepoRoot.TrimEnd('/') + "/" + let rel (p: string) = if p.StartsWith(root) then p.Substring(root.Length) else p + let lines = + uses |> Array.map (fun u -> + let kind = if u.IsFromDefinition then "DEF" elif u.IsFromType then "TYPE" else "USE" + $"{kind} {rel u.Range.FileName}:{u.Range.StartLine},{u.Range.StartColumn}") + |> Array.distinct + let sym = symbolUse.Symbol + let header = $"Symbol: {sym.DisplayName} ({sym.GetType().Name}) — {lines.Length} references" + return header + "\n" + (lines |> String.concat "\n") | "typeHints" -> let file = Path.GetFullPath(doc.RootElement.GetProperty("file").GetString()) @@ -211,69 +186,84 @@ let startServer (config: ServerConfig) = if not (File.Exists file) then return $"ERROR: file not found: {file}" else - let! optionsResult = getOptions () - - match optionsResult with - | Error msg -> return $"ERROR: {msg}" - | Ok options -> - let sourceText = SourceText.ofString (File.ReadAllText(file)) - let version = File.GetLastWriteTimeUtc(file).Ticks |> int - let! _, checkAnswer = checker.ParseAndCheckFileInProject(file, version, sourceText, options) - - match checkAnswer with - | FSharpCheckFileAnswer.Aborted -> return "ERROR: check aborted" - | FSharpCheckFileAnswer.Succeeded checkResults -> - let allSymbols = checkResults.GetAllUsesOfAllSymbolsInFile() - let sourceLines = File.ReadAllLines(file) - // Collect type annotations per line: (name: Type) - let annotations = System.Collections.Generic.Dictionary>() - - let addHint line hint = - if not (annotations.ContainsKey line) then - annotations.[line] <- ResizeArray() - - annotations.[line].Add(hint) - - let tagsToStr (tags: FSharp.Compiler.Text.TaggedText[]) = - tags |> Array.map (fun t -> t.Text) |> String.concat "" - - for su in allSymbols do - let r = su.Range - - if r.StartLine >= startLine && r.StartLine <= endLine && su.IsFromDefinition then - match su.Symbol with - | :? FSharpMemberOrFunctionOrValue as mfv -> - match mfv.GetReturnTypeLayout(su.DisplayContext) with - | Some tags -> - let typeStr = tagsToStr tags - // Format as F# type annotation: (name: Type) - addHint r.StartLine $"({mfv.DisplayName}: {typeStr})" - | None -> - // Fallback: try FullType - try - addHint r.StartLine $"({mfv.DisplayName}: {mfv.FullType.Format(su.DisplayContext)})" - with _ -> - () - | :? FSharpField as fld -> - try - addHint r.StartLine $"({fld.DisplayName}: {fld.FieldType.Format(su.DisplayContext)})" - with _ -> - () - | _ -> () - // Render lines with inline type comments - let sb = StringBuilder() - - for i in startLine..endLine do - if i >= 1 && i <= sourceLines.Length then - let line = sourceLines.[i - 1] - - match annotations.TryGetValue(i) with - | true, hints -> - let comment = hints |> Seq.distinct |> String.concat " " - sb.AppendLine($"{line} // {comment}") |> ignore - | _ -> sb.AppendLine(line) |> ignore - - return sb.ToString().TrimEnd() + let! optionsResult = getOptions file + match optionsResult with + | Error msg -> return $"ERROR: {msg}" + | Ok options -> + let sourceText = SourceText.ofString (File.ReadAllText(file)) + let version = File.GetLastWriteTimeUtc(file).Ticks |> int + let! _, checkAnswer = checker.ParseAndCheckFileInProject(file, version, sourceText, options) + match checkAnswer with + | FSharpCheckFileAnswer.Aborted -> return "ERROR: check aborted" + | FSharpCheckFileAnswer.Succeeded checkResults -> + let allSymbols = checkResults.GetAllUsesOfAllSymbolsInFile() + let sourceLines = File.ReadAllLines(file) + // Collect type annotations per line: (name: Type) + let annotations = System.Collections.Generic.Dictionary>() + let addHint line hint = + if not (annotations.ContainsKey line) then annotations.[line] <- ResizeArray() + annotations.[line].Add(hint) + let tagsToStr (tags: FSharp.Compiler.Text.TaggedText[]) = + tags |> Array.map (fun t -> t.Text) |> String.concat "" + for su in allSymbols do + let r = su.Range + if r.StartLine >= startLine && r.StartLine <= endLine && su.IsFromDefinition then + match su.Symbol with + | :? FSharpMemberOrFunctionOrValue as mfv -> + match mfv.GetReturnTypeLayout(su.DisplayContext) with + | Some tags -> + let typeStr = tagsToStr tags + // Format as F# type annotation: (name: Type) + addHint r.StartLine $"({mfv.DisplayName}: {typeStr})" + | None -> + // Fallback: try FullType + try addHint r.StartLine $"({mfv.DisplayName}: {mfv.FullType.Format(su.DisplayContext)})" + with _ -> () + | :? FSharpField as fld -> + try addHint r.StartLine $"({fld.DisplayName}: {fld.FieldType.Format(su.DisplayContext)})" + with _ -> () + | _ -> () + // Render lines with inline type comments + let sb = StringBuilder() + for i in startLine .. endLine do + if i >= 1 && i <= sourceLines.Length then + let line = sourceLines.[i - 1] + match annotations.TryGetValue(i) with + | true, hints -> + let comment = hints |> Seq.distinct |> String.concat " " + sb.AppendLine($"{line} // {comment}") |> ignore + | _ -> + sb.AppendLine(line) |> ignore + return sb.ToString().TrimEnd() + + | "compile" -> + let project = doc.RootElement.GetProperty("project").GetString() + let output = doc.RootElement.GetProperty("output").GetString() + if not (File.Exists project) then + return $"ERROR: project not found: {project}" + else + let sw = System.Diagnostics.Stopwatch.StartNew() + let! optionsResult = projectMgr.ResolveProjectOptions(project) + let dtbTime = sw.Elapsed.TotalMilliseconds + match optionsResult with + | Error msg -> + return $"ERROR: {msg}" + | Ok options -> + sw.Restart() + let! results = checker.ParseAndCheckProject(options) + let checkTime = sw.Elapsed.TotalMilliseconds + if results.HasCriticalErrors then + let diags = DiagnosticsFormatter.formatProject config.RepoRoot results.Diagnostics + return $"ERROR: Project has errors:\n{diags}" + else + try + sw.Restart() + let! _ = checker.CompileFromCheckedProject(results, output) + let emitTime = sw.Elapsed.TotalMilliseconds + eprintfn $"[fsharp-diag] compile: DTB={dtbTime:F0}ms Check={checkTime:F0}ms Emit={emitTime:F0}ms Total={dtbTime+checkTime+emitTime:F0}ms" + return "OK" + with ex -> + return $"ERROR: Compile failed: {ex.Message}" | "shutdown" -> cts.Cancel() @@ -286,9 +276,60 @@ let startServer (config: ServerConfig) = File.WriteAllText(metaPath, $"""{{ "repoRoot":"{config.RepoRoot}", "pid":{Environment.ProcessId} }}""") - use listener = - new Socket(AddressFamily.Unix, SocketType.Stream, ProtocolType.Unspecified) + // ── Filewatcher: pre-warm cache on source changes ── + // Watch src/Compiler/ for .fs/.fsi changes. On modification, after a 5s quiet period, + // request a ParseAndCheckProject to warm the TransparentCompiler cache. + // By the time MSBuild calls us, the typecheck is already done. + let mutable lastFileChange = DateTimeOffset.MinValue + let watchPath = Path.Combine(config.RepoRoot, "src", "Compiler") + let fcsProjectPath = + Path.Combine(config.RepoRoot, "src", "Compiler", "FSharp.Compiler.Service.fsproj") + let prewarmThrottleMs = 5_000 + + let prewarmCache () = + async { + try + let! optionsResult = projectMgr.ResolveProjectOptions(fcsProjectPath) + match optionsResult with + | Ok options -> + let sw = System.Diagnostics.Stopwatch.StartNew() + let! _results = checker.ParseAndCheckProject(options) + eprintfn $"[fsharp-diag] Prewarm: typechecked in {sw.Elapsed.TotalMilliseconds:F0}ms" + | Error msg -> + eprintfn $"[fsharp-diag] Prewarm: options error: {msg}" + with ex -> + eprintfn $"[fsharp-diag] Prewarm: error: {ex.Message}" + } + let schedulePrewarm () = + lastFileChange <- DateTimeOffset.UtcNow + let snapshot = lastFileChange + Async.Start( + async { + do! Async.Sleep(prewarmThrottleMs) + // Only fire if no newer change arrived during the throttle window + if lastFileChange = snapshot then + eprintfn $"[fsharp-diag] File change detected, pre-warming cache..." + do! prewarmCache () + }, cts.Token) + + let watcher = + if Directory.Exists(watchPath) then + let w = new FileSystemWatcher(watchPath, IncludeSubdirectories = true) + w.Filters.Add("*.fs") + w.Filters.Add("*.fsi") + w.NotifyFilter <- NotifyFilters.LastWrite ||| NotifyFilters.FileName + w.Changed.Add(fun _ -> schedulePrewarm ()) + w.Created.Add(fun _ -> schedulePrewarm ()) + w.Renamed.Add(fun _ -> schedulePrewarm ()) + w.EnableRaisingEvents <- true + eprintfn $"[fsharp-diag] Watching {watchPath} for source changes (5s throttle)" + Some w + else + eprintfn $"[fsharp-diag] Watch path not found: {watchPath}" + None + + use listener = new Socket(AddressFamily.Unix, SocketType.Stream, ProtocolType.Unspecified) listener.Bind(UnixDomainSocketEndPoint(socketPath)) listener.Listen(10) File.SetUnixFileMode(socketPath, UnixFileMode.UserRead ||| UnixFileMode.UserWrite ||| UnixFileMode.UserExecute) @@ -332,15 +373,8 @@ let startServer (config: ServerConfig) = | :? OperationCanceledException -> () | ex -> eprintfn $"[fsharp-diag] Error: {ex.Message}" - try - File.Delete(socketPath) - with _ -> - () - - try - File.Delete(metaPath) - with _ -> - () - + try File.Delete(socketPath) with _ -> () + try File.Delete(metaPath) with _ -> () + watcher |> Option.iter (fun w -> w.Dispose()) eprintfn "[fsharp-diag] Shut down." } diff --git a/.github/skills/fsharp-diagnostics/tests/DesignTimeBuildTests.fs b/.github/skills/fsharp-diagnostics/tests/DesignTimeBuildTests.fs new file mode 100644 index 00000000000..5c13a1132d6 --- /dev/null +++ b/.github/skills/fsharp-diagnostics/tests/DesignTimeBuildTests.fs @@ -0,0 +1,28 @@ +module FSharpDiagServer.Tests.DesignTimeBuildTests + +open Xunit +open FSharpDiagServer.DesignTimeBuild + +[] +let ``defaultConfig has expected values`` () = + Assert.Equal(Some "net10.0", defaultConfig.TargetFramework) + Assert.Equal("Release", defaultConfig.Configuration) + +[] +let ``DtbResult can hold compiler args`` () = + let result = { CompilerArgs = [| "--debug"; "src/A.fs" |]; IntermediateOutputPath = "obj/Release/" } + Assert.Equal(2, result.CompilerArgs.Length) + Assert.Equal("--debug", result.CompilerArgs.[0]) + +[] +[] +[] +let ``DtbConfig construction preserves values`` (tfm: string, cfg: string) = + let config = { TargetFramework = Option.ofObj tfm; Configuration = cfg } + Assert.Equal(Option.ofObj tfm, config.TargetFramework) + Assert.Equal(cfg, config.Configuration) + +[] +let ``DtbResult with empty CompilerArgs`` () = + let result = { CompilerArgs = [||]; IntermediateOutputPath = "" } + Assert.Empty(result.CompilerArgs) diff --git a/.github/skills/fsharp-diagnostics/tests/Directory.Build.props b/.github/skills/fsharp-diagnostics/tests/Directory.Build.props new file mode 100644 index 00000000000..3e4e8b38c63 --- /dev/null +++ b/.github/skills/fsharp-diagnostics/tests/Directory.Build.props @@ -0,0 +1,7 @@ + + + false + $(MSBuildThisFileDirectory)../../../../.tools/fsharp-diag/test-bin/ + $(MSBuildThisFileDirectory)../../../../.tools/fsharp-diag/test-obj/ + + diff --git a/.github/skills/fsharp-diagnostics/tests/FSharpDiagServer.Tests.fsproj b/.github/skills/fsharp-diagnostics/tests/FSharpDiagServer.Tests.fsproj new file mode 100644 index 00000000000..1bc86264dc4 --- /dev/null +++ b/.github/skills/fsharp-diagnostics/tests/FSharpDiagServer.Tests.fsproj @@ -0,0 +1,25 @@ + + + + net10.0 + false + + + + + + + + + + + + + + + + + + + + diff --git a/.github/skills/fsharp-diagnostics/tests/ProjectManagerTests.fs b/.github/skills/fsharp-diagnostics/tests/ProjectManagerTests.fs new file mode 100644 index 00000000000..5eb7d088bab --- /dev/null +++ b/.github/skills/fsharp-diagnostics/tests/ProjectManagerTests.fs @@ -0,0 +1,183 @@ +module FSharpDiagServer.Tests.ProjectManagerTests + +open Xunit +open FSharp.Compiler.CodeAnalysis +open FSharpDiagServer.ProjectManager + +let private createManager () = + let checker = FSharpChecker.Create() + ProjectManager(checker) + +let private dummyOptions projPath = + { FSharpProjectOptions.ProjectFileName = projPath + ProjectId = None + SourceFiles = [||] + OtherOptions = [||] + ReferencedProjects = [||] + IsIncompleteTypeCheckEnvironment = false + UseScriptResolutionRules = false + LoadTime = System.DateTime.MinValue + UnresolvedReferences = None + OriginalLoadReferences = [] + Stamp = None } + +[] +let ``New manager has empty cache`` () = + let mgr = createManager () + Assert.Equal(0, mgr.CacheCount) + +[] +let ``InjectTestEntry populates cache`` () = + let mgr = createManager () + mgr.InjectTestEntry("/a.fsproj", dummyOptions "/a.fsproj") + Assert.Equal(1, mgr.CacheCount) + Assert.True(mgr.HasCachedProject("/a.fsproj")) + +[] +let ``Invalidate all clears entire cache`` () = + let mgr = createManager () + mgr.InjectTestEntry("/a.fsproj", dummyOptions "/a.fsproj") + mgr.InjectTestEntry("/b.fsproj", dummyOptions "/b.fsproj") + + mgr.Invalidate() + + Assert.Equal(0, mgr.CacheCount) + Assert.False(mgr.HasCachedProject("/a.fsproj")) + Assert.False(mgr.HasCachedProject("/b.fsproj")) + +[] +let ``Invalidate nonexistent path leaves cache unchanged`` () = + let mgr = createManager () + mgr.InjectTestEntry("/a.fsproj", dummyOptions "/a.fsproj") + + mgr.Invalidate("/nonexistent.fsproj") + + Assert.Equal(1, mgr.CacheCount) + Assert.True(mgr.HasCachedProject("/a.fsproj")) + +[] +let ``Invalidate on empty cache is idempotent`` () = + let mgr = createManager () + mgr.Invalidate() + mgr.Invalidate("/x.fsproj") + Assert.Equal(0, mgr.CacheCount) + +[] +let ``HasCachedProject normalizes paths`` () = + let mgr = createManager () + mgr.InjectTestEntry("/a/../b/c.fsproj", dummyOptions "/b/c.fsproj") + Assert.True(mgr.HasCachedProject("/b/c.fsproj")) + +[] +let ``Invalidate normalizes path before removal`` () = + let mgr = createManager () + mgr.InjectTestEntry("/b/c.fsproj", dummyOptions "/b/c.fsproj") + Assert.Equal(1, mgr.CacheCount) + + mgr.Invalidate("/a/../b/c.fsproj") + + Assert.Equal(0, mgr.CacheCount) + Assert.False(mgr.HasCachedProject("/b/c.fsproj")) + +[] +let ``InjectTestEntry overwrites existing entry for same normalized path`` () = + let mgr = createManager () + mgr.InjectTestEntry("/a.fsproj", dummyOptions "/a.fsproj") + mgr.InjectTestEntry("/a.fsproj", dummyOptions "/a.fsproj") + Assert.Equal(1, mgr.CacheCount) + +[] +let ``Multiple distinct projects coexist in cache`` () = + let mgr = createManager () + mgr.InjectTestEntry("/project1.fsproj", dummyOptions "/project1.fsproj") + mgr.InjectTestEntry("/project2.fsproj", dummyOptions "/project2.fsproj") + mgr.InjectTestEntry("/project3.fsproj", dummyOptions "/project3.fsproj") + Assert.Equal(3, mgr.CacheCount) + Assert.True(mgr.HasCachedProject("/project1.fsproj")) + Assert.True(mgr.HasCachedProject("/project2.fsproj")) + Assert.True(mgr.HasCachedProject("/project3.fsproj")) + +[] +let ``Invalidate specific project preserves others`` () = + let mgr = createManager () + mgr.InjectTestEntry("/x.fsproj", dummyOptions "/x.fsproj") + mgr.InjectTestEntry("/y.fsproj", dummyOptions "/y.fsproj") + mgr.InjectTestEntry("/z.fsproj", dummyOptions "/z.fsproj") + + mgr.Invalidate("/y.fsproj") + + Assert.Equal(2, mgr.CacheCount) + Assert.True(mgr.HasCachedProject("/x.fsproj")) + Assert.False(mgr.HasCachedProject("/y.fsproj")) + Assert.True(mgr.HasCachedProject("/z.fsproj")) + +[] +let ``ResolveProjectOptions returns Error for nonexistent project`` () = + let mgr = createManager () + // DTB run will throw because the working directory doesn't exist; + // verify the error propagates without crashing the manager. + let ex = + Assert.ThrowsAny(fun () -> + mgr.ResolveProjectOptions("/nonexistent/path/project.fsproj") + |> Async.RunSynchronously + |> ignore) + Assert.NotNull(ex) + +[] +let ``Concurrent InjectTestEntry and Invalidate do not corrupt cache`` () = + let mgr = createManager () + let iterations = 100 + let tasks = + [| for i in 0 .. iterations - 1 do + async { + let path = $"/concurrent_{i}.fsproj" + mgr.InjectTestEntry(path, dummyOptions path) + mgr.Invalidate(path) + } |] + tasks |> Async.Parallel |> Async.RunSynchronously |> ignore + // After all inject+invalidate pairs, cache should be empty + Assert.Equal(0, mgr.CacheCount) + +[] +let ``Concurrent InjectTestEntry from multiple threads`` () = + let mgr = createManager () + let count = 50 + let tasks = + [| for i in 0 .. count - 1 do + async { + let path = $"/parallel_{i}.fsproj" + mgr.InjectTestEntry(path, dummyOptions path) + } |] + tasks |> Async.Parallel |> Async.RunSynchronously |> ignore + Assert.Equal(count, mgr.CacheCount) + +[] +let ``Invalidate specific during concurrent reads preserves other entries`` () = + let mgr = createManager () + for i in 0 .. 9 do + mgr.InjectTestEntry($"/stable_{i}.fsproj", dummyOptions $"/stable_{i}.fsproj") + let tasks = + [| for i in 0 .. 4 do + async { + mgr.Invalidate($"/stable_{i}.fsproj") + } + for i in 5 .. 9 do + async { + Assert.True(mgr.HasCachedProject($"/stable_{i}.fsproj")) + } |] + tasks |> Async.Parallel |> Async.RunSynchronously |> ignore + // First 5 removed, last 5 remain + Assert.Equal(5, mgr.CacheCount) + +[] +let ``ResolveProjectOptions error does not pollute cache`` () = + let mgr = createManager () + mgr.InjectTestEntry("/good.fsproj", dummyOptions "/good.fsproj") + // Attempting to resolve a nonexistent project should not affect existing cache + try + mgr.ResolveProjectOptions("/nonexistent/bad.fsproj") + |> Async.RunSynchronously + |> ignore + with _ -> () + Assert.Equal(1, mgr.CacheCount) + Assert.True(mgr.HasCachedProject("/good.fsproj")) diff --git a/.github/skills/fsharp-diagnostics/tests/ResolveProjectTests.fs b/.github/skills/fsharp-diagnostics/tests/ResolveProjectTests.fs new file mode 100644 index 00000000000..533b8d8f333 --- /dev/null +++ b/.github/skills/fsharp-diagnostics/tests/ResolveProjectTests.fs @@ -0,0 +1,29 @@ +module FSharpDiagServer.Tests.ResolveProjectTests + +open Xunit +open FSharpDiagServer.ProjectRouting + +let private fcs root = + System.IO.Path.Combine(root, "src/Compiler/FSharp.Compiler.Service.fsproj") + +let private componentTests root = + System.IO.Path.Combine(root, "tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj") + +[] +[] +[] +[] +[] +[] +[] +[] +[] +[] +// Edge case: "repo" substring inside ComponentTests path should not confuse stripping +[] +// Non-ComponentTests test project should fall back to FCS +[] +let ``resolveProject routes files to correct fsproj`` (repoRoot: string, filePath: string, expectFcs: bool) = + let result = resolveProject repoRoot filePath + let expected = if expectFcs then fcs repoRoot else componentTests repoRoot + Assert.Equal(expected, result) diff --git a/FSharpBuild.Directory.Build.targets b/FSharpBuild.Directory.Build.targets index 6e64ad71531..5301e611699 100644 --- a/FSharpBuild.Directory.Build.targets +++ b/FSharpBuild.Directory.Build.targets @@ -162,4 +162,8 @@ + + + diff --git a/FSharpTests.Directory.Build.targets b/FSharpTests.Directory.Build.targets index 2e0b335b411..9b8d49a124d 100644 --- a/FSharpTests.Directory.Build.targets +++ b/FSharpTests.Directory.Build.targets @@ -42,4 +42,8 @@ + + + diff --git a/docs/release-notes/.FSharp.Compiler.Service/10.0.300.md b/docs/release-notes/.FSharp.Compiler.Service/10.0.300.md index 56edf5d2cda..3b830fbd666 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/10.0.300.md +++ b/docs/release-notes/.FSharp.Compiler.Service/10.0.300.md @@ -5,6 +5,8 @@ ### Added +* Added internal `CompileFromCheckedProject` API to `FSharpChecker` for emitting DLLs directly from typecheck cache, enabling fast dev-loop builds. ([PR #19267](https://github.com/dotnet/fsharp/pull/19267)) + ### Changed * Centralized product TFM (Target Framework Moniker) into MSBuild props file `eng/TargetFrameworks.props`. Changing the target framework now only requires editing one file, and it integrates with MSBuild's `--getProperty` for scripts. diff --git a/eng/targets/FastBuildFromCache.targets b/eng/targets/FastBuildFromCache.targets new file mode 100644 index 00000000000..a22f353178c --- /dev/null +++ b/eng/targets/FastBuildFromCache.targets @@ -0,0 +1,251 @@ + + + + + + <_FastBuildFromCacheActive>true + <_FastBuildScript>$(RepoRoot).github/skills/fsharp-diagnostics/scripts/get-fsharp-errors.sh + + + + + + + + + + + + + + + + true + + + + + + + + + + + + + + + + + + + + + + + diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index dc6d346048b..75985967fd6 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -1385,6 +1385,14 @@ and [] TcImports | Some res -> res | None -> error (Error(FSComp.SR.buildCouldNotResolveAssembly assemblyName, m)) + member internal tcImports.NormalizeAssemblyRef(ctok, aref: ILAssemblyRef) = + match tcImports.TryFindDllInfo(ctok, rangeStartup, aref.Name, lookupOnly = false) with + | Some dllInfo -> + match dllInfo.ILScopeRef with + | ILScopeRef.Assembly ref -> ref + | _ -> aref + | None -> aref + member _.GetImportedAssemblies() = tciLock.AcquireLock(fun tcitok -> CheckDisposed() diff --git a/src/Compiler/Driver/CompilerImports.fsi b/src/Compiler/Driver/CompilerImports.fsi index 9da0ef71b1d..3aae4c30158 100644 --- a/src/Compiler/Driver/CompilerImports.fsi +++ b/src/Compiler/Driver/CompilerImports.fsi @@ -166,6 +166,9 @@ type TcImports = member TryFindDllInfo: CompilationThreadToken * range * string * lookupOnly: bool -> ImportedBinary option + /// Normalize an assembly reference by resolving it through the imported assemblies table. + member internal NormalizeAssemblyRef: CompilationThreadToken * ILAssemblyRef -> ILAssemblyRef + member FindCcuFromAssemblyRef: CompilationThreadToken * range * ILAssemblyRef -> CcuResolutionResult #if !NO_TYPEPROVIDERS diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index a11231319dd..a7b18f2e78f 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -1101,12 +1101,7 @@ let main6 FileSystem.GetFullPathShim(absolutePath)) let normalizeAssemblyRefs (aref: ILAssemblyRef) = - match tcImports.TryFindDllInfo(ctok, rangeStartup, aref.Name, lookupOnly = false) with - | Some dllInfo -> - match dllInfo.ILScopeRef with - | ILScopeRef.Assembly ref -> ref - | _ -> aref - | None -> aref + tcImports.NormalizeAssemblyRef(ctok, aref) match dynamicAssemblyCreator with | None -> diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index 6bd4b798cda..88321dc9a2f 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -98,6 +98,7 @@ + diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index b215075fb0e..74dfd3b54b2 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -3834,6 +3834,13 @@ type FSharpCheckProjectResults FSharpAssemblyContents(tcGlobals, thisCcu, Some ccuSig, tcImports, mimpls) + member internal _.CompilationData = + let tcGlobals, tcImports, thisCcu, ccuSig, _, topAttribs, _, ilAssemRef, _, tcAssemblyExpr, _, _ = + getDetails () + + let tcConfig = getTcConfig () + (tcConfig, tcGlobals, tcImports, thisCcu, ccuSig, topAttribs, ilAssemRef, tcAssemblyExpr) + member _.GetOptimizedAssemblyContents() = if not keepAssemblyContents then invalidOp diff --git a/src/Compiler/Service/FSharpCheckerResults.fsi b/src/Compiler/Service/FSharpCheckerResults.fsi index 25c38a49d50..05266287790 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fsi +++ b/src/Compiler/Service/FSharpCheckerResults.fsi @@ -532,6 +532,18 @@ type public FSharpCheckProjectResults = /// Get an optimized view of the overall contents of the assembly. Only valid to use if HasCriticalErrors is false. member GetOptimizedAssemblyContents: unit -> FSharpAssemblyContents + /// Get the internal compilation data needed for CompileFromCheckedProject. + /// Requires keepAssemblyContents=true. + member internal CompilationData: + TcConfig * + TcGlobals * + TcImports * + CcuThunk * + ModuleOrNamespaceType * + TopAttribs option * + ILAssemblyRef * + CheckedImplFile list option + /// Get the resolution of the ProjectOptions member ProjectContext: FSharpProjectContext diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index de3635f516f..f2aaaf5845f 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -6,18 +6,27 @@ open System open Internal.Utilities.Collections open Internal.Utilities.Library open FSharp.Compiler +open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILBinaryReader +open FSharp.Compiler.AbstractIL.ILBinaryWriter +open FSharp.Compiler.CheckExpressionsOps open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.CodeAnalysis.TransparentCompiler open FSharp.Compiler.CompilerConfig +open FSharp.Compiler.CompilerImports open FSharp.Compiler.CompilerOptions +open FSharp.Compiler.CreateILModule open FSharp.Compiler.Diagnostics open FSharp.Compiler.Driver open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.IlxGen +open FSharp.Compiler.OptimizeInputs open FSharp.Compiler.Symbols open FSharp.Compiler.Tokenization open FSharp.Compiler.Text open FSharp.Compiler.Text.Range +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeOps /// Callback that indicates whether a requested result has become obsolete. [] @@ -624,6 +633,221 @@ type FSharpChecker member internal _.FrameworkImportsCache = backgroundCompiler.FrameworkImportsCache + /// Compile a DLL from cached typecheck results, skipping parse/typecheck/optimization. + /// For dev-loop use only. Requires keepAssemblyContents=true. + /// Returns the output file path on success. + member internal _.CompileFromCheckedProject(results: FSharpCheckProjectResults, outfile: string) = + async { + let tcConfig, tcGlobals, tcImports, unfinalizedCcu, ccuSig, topAttrsOpt, _ilAssemRef, typedImplFilesOpt = + results.CompilationData + + ReportTime tcConfig "CompileFromCheckedProject: Setup" + + // The CCU from TransparentCompiler has unfinalized Contents (empty ModuleOrNamespaceType). + // Finalize it using ccuSig, matching what CheckClosedInputSetFinish does. + let ccuContents = Construct.NewCcuContents ILScopeRef.Local range0 unfinalizedCcu.AssemblyName ccuSig + let generatedCcu = unfinalizedCcu.CloneWithFinalizedContents(ccuContents) + + let topAttrs = + match topAttrsOpt with + | Some a -> a + | None -> raise (InvalidOperationException "CompileFromCheckedProject: no top attributes available") + + let typedImplFiles = + match typedImplFilesOpt with + | Some files -> files + | None -> raise (InvalidOperationException "CompileFromCheckedProject: keepAssemblyContents must be true") + + // Note: We do NOT filter files with diagnostics here. FSharpCheckProjectResults.Diagnostics + // may include warnings promoted to errors (e.g. FS1182 from --warnaserror+:1182) that + // are suppressed by #nowarn in the source. These files compiled successfully in the + // normal fsc pipeline and must be included here for IlxGen to resolve all types. + // If there are genuine type-check errors, IlxGen will fail and we fall back to fsc. + + // Deduplicate QualifiedNameOfFile values. TransparentCompiler processes files + // via dependency graph (potentially parallel), so the per-file DeduplicateParsedInputModuleName + // may not see all prior names. Re-deduplicate here to avoid startup code type collisions. + let typedImplFiles = + typedImplFiles + |> List.mapFold + (fun (seen: Map) (f: CheckedImplFile) -> + let name = f.QualifiedNameOfFile.Text + + match seen.TryFind name with + | None -> f, seen.Add(name, 1) + | Some count -> + let newCount = count + 1 + let newName = name + "___" + string newCount + + let newQName = + FSharp.Compiler.Syntax.QualifiedNameOfFile(FSharp.Compiler.Syntax.Ident(newName, f.QualifiedNameOfFile.Range)) + + let (CheckedImplFile(_, sig', contents, hasEntry, isScript, anonRecs, namedDbgPts)) = f + CheckedImplFile(newQName, sig', contents, hasEntry, isScript, anonRecs, namedDbgPts), seen.Add(name, newCount)) + Map.empty + |> fst + + // Save and restore CCU attribs to prevent quadratic growth on repeated compile calls. + let originalAttribs = generatedCcu.Contents.Attribs + generatedCcu.Contents.SetAttribs(originalAttribs @ topAttrs.assemblyAttrs) + + use _restoreAttribs = + { new System.IDisposable with + member _.Dispose() = + generatedCcu.Contents.SetAttribs(originalAttribs) + } + + let exportRemapping = MakeExportRemapping generatedCcu generatedCcu.Contents + + ReportTime tcConfig "CompileFromCheckedProject: Encode Signature Data" + + let sigDataAttributes, sigDataResources = + EncodeSignatureData(tcConfig, tcGlobals, exportRemapping, generatedCcu, outfile, false) + + let tcVal = LightweightTcValForUsingInBuildMethodCall tcGlobals + let importMap = tcImports.GetImportMap() + let optEnv0 = GetInitialOptimizationEnv(tcImports, tcGlobals) + + ReportTime tcConfig "CompileFromCheckedProject: Optimizations" + + // Dev-loop optimization: use minimal passes only (no extra loops, no detuple, + // no TLR, no cross-assembly opt). This DLL is for local testing, not shipping. + // OptimizeImplFile + LowerLocalMutables + LowerCalls are mandatory for correct IlxGen. + let optimizedImpls, optDataResources = + let minimalSettings = + { tcConfig.optSettings with + jitOptUser = Some false + localOptUser = Some false + crossAssemblyOptimizationUser = Some false + lambdaInlineThreshold = 0 + abstractBigTargets = false + reportingPhase = false + } + + let impls = + typedImplFiles + |> List.mapFold + (fun (env, hidingInfo) implFile -> + let (env', file, _optInfo, hidingInfo'), optDuringCodeGen = + Optimizer.OptimizeImplFile( + minimalSettings, + generatedCcu, + tcGlobals, + tcVal, + importMap, + env, + false, + tcConfig.emitTailcalls, + hidingInfo, + implFile + ) + + let file = LowerLocalMutables.TransformImplFile tcGlobals importMap file + let file = LowerCalls.LowerImplFile tcGlobals file + + { + ImplFile = file + OptimizeDuringCodeGen = optDuringCodeGen + }, + (env', hidingInfo')) + (optEnv0, SignatureHidingInfo.Empty) + |> fst + |> CheckedAssemblyAfterOptimization + + impls, [] + + ReportTime tcConfig "CompileFromCheckedProject: TAST -> IL" + let ilxGenerator = CreateIlxAssemblyGenerator(tcConfig, tcImports, tcGlobals, tcVal, generatedCcu) + + let codegenResults = + GenerateIlxCode(IlWriteBackend, false, tcConfig, topAttrs, optimizedImpls, generatedCcu.AssemblyName, ilxGenerator) + + let topAssemblyAttrs = codegenResults.topAssemblyAttrs + + let topAttrs = + { topAttrs with + assemblyAttrs = topAssemblyAttrs + } + + let secDecls = mkILSecurityDecls codegenResults.permissionSets + + let metadataVersion = + match tcConfig.metadataVersion with + | Some v -> v + | _ -> "" + + let ctok = CompilationThreadToken() + + // Extract AssemblyVersionAttribute from typed assembly attributes, matching fsc's logic. + let assemVerFromAttrib = + match AttributeHelpers.TryFindStringAttribute tcGlobals "System.Reflection.AssemblyVersionAttribute" topAttrs.assemblyAttrs with + | Some versionString -> + try + Some(parseILVersion versionString) + with _ -> + None + | _ -> + match tcConfig.version with + | VersionNone -> Some(ILVersionInfo(0us, 0us, 0us, 0us)) + | _ -> Some(tcConfig.version.GetVersionInfo tcConfig.implicitIncludeDir) + + let ilxMainModule = + let m = + MainModuleBuilder.CreateMainModule( + ctok, + tcConfig, + tcGlobals, + tcImports, + None, + generatedCcu.AssemblyName, + outfile, + topAttrs, + sigDataAttributes, + sigDataResources, + optDataResources, + codegenResults, + assemVerFromAttrib, + metadataVersion, + secDecls + ) + // Strip native resources — default.win32manifest may not exist on all platforms. + { m with NativeResources = [] } + + let normalizeAssemblyRefs (aref: ILAssemblyRef) = + tcImports.NormalizeAssemblyRef(ctok, aref) + + ReportTime tcConfig "CompileFromCheckedProject: Write .NET Binary" + + WriteILBinaryFile( + { + ilg = tcGlobals.ilg + outfile = outfile + pdbfile = None + emitTailcalls = tcConfig.emitTailcalls + deterministic = tcConfig.deterministic + portablePDB = false + embeddedPDB = false + embedAllSource = false + embedSourceList = [] + allGivenSources = [] + sourceLink = "" + checksumAlgorithm = tcConfig.checksumAlgorithm + signer = GetStrongNameSigner(ValidateKeySigningAttributes(tcConfig, tcGlobals, topAttrs)) + dumpDebugInfo = false + referenceAssemblyOnly = false + referenceAssemblyAttribOpt = None + referenceAssemblySignatureHash = None + pathMap = tcConfig.pathMap + }, + ilxMainModule, + normalizeAssemblyRefs + ) + + ReportTime tcConfig "Exiting" + + return outfile + } + /// Tokenize a single line, returning token information and a tokenization state represented by an integer member _.TokenizeLine(line: string, state: FSharpTokenizerLexState) = let tokenizer = FSharpSourceTokenizer([], None, None, None) diff --git a/src/Compiler/Service/service.fsi b/src/Compiler/Service/service.fsi index 2120cab1eef..31aef3d1cdf 100644 --- a/src/Compiler/Service/service.fsi +++ b/src/Compiler/Service/service.fsi @@ -508,6 +508,11 @@ type public FSharpChecker = member internal FrameworkImportsCache: FrameworkImportsCache member internal ReferenceResolver: LegacyReferenceResolver + /// Compile a DLL from cached typecheck results, skipping parse/typecheck/optimization. + /// For dev-loop use only. Requires keepAssemblyContents=true. + /// Returns the output file path on success. + member internal CompileFromCheckedProject: results: FSharpCheckProjectResults * outfile: string -> Async + /// Tokenize a single line, returning token information and a tokenization state represented by an integer member TokenizeLine: line: string * state: FSharpTokenizerLexState -> FSharpTokenInfo[] * FSharpTokenizerLexState diff --git a/tests/FSharp.Compiler.Service.Tests/PerfTests.fs b/tests/FSharp.Compiler.Service.Tests/PerfTests.fs index 8a9ac73740a..be3eb8a5b94 100644 --- a/tests/FSharp.Compiler.Service.Tests/PerfTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/PerfTests.fs @@ -95,3 +95,33 @@ let ``Test request for parse and check doesn't check whole project`` () = printfn "checking no extra background typechecks...., backgroundCheckCount.Value = %d" backgroundCheckCount.Value (backgroundCheckCount.Value <= 10) |> shouldEqual true // only two extra typechecks of files () + +[] +let ``CompileFromCheckedProject does not cause quadratic attribute growth`` () = + let source = """ +module TestLib + +[] +do () + +let add x y = x + y +""" + let options = createProjectOptions [ source ] [] + let compileChecker = FSharpChecker.Create(keepAssemblyContents = true, useTransparentCompiler = false) + let results = compileChecker.ParseAndCheckProject(options) |> Async.RunImmediate + + Assert.False(results.HasCriticalErrors, "Project should have no critical errors") + + let _tcConfig, _tcGlobals, _tcImports, generatedCcu, _ccuSig, _topAttrsOpt, _ilAssemRef, _typedImplFilesOpt = + results.CompilationData + + let attribCountBefore = generatedCcu.Contents.Attribs.Length + + let outDir = Path.GetDirectoryName(options.SourceFiles[0]) + for i in 1..3 do + let outFile = Path.Combine(outDir, $"TestLib_{i}.dll") + compileChecker.CompileFromCheckedProject(results, outFile) |> Async.RunImmediate |> ignore + Assert.True(File.Exists(outFile), $"Output DLL should exist: {outFile}") + + let attribCountAfter = generatedCcu.Contents.Attribs.Length + Assert.Equal(attribCountBefore, attribCountAfter)