From 6a88987487e92c7cc19d3d93406b3f5fe1793a9c Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Mon, 15 Nov 2021 13:55:57 -0800 Subject: [PATCH 01/13] Added service_slim --- .vscode/launch.json | 12 +- buildtools/buildtools.targets | 4 +- fcs/build.sh | 4 + fcs/fcs-test/NuGet.config | 10 + fcs/fcs-test/Program.fs | 124 +++++++ fcs/fcs-test/ast_print.fs | 101 ++++++ fcs/fcs-test/fcs-test.fsproj | 26 ++ fcs/fcs-test/test_script.fsx | 8 + fcs/service_slim.fs | 303 ++++++++++++++++++ src/Compiler/Checking/QuotationTranslator.fs | 2 + src/Compiler/FSharp.Compiler.Service.fsproj | 2 + src/Compiler/Service/FSharpCheckerResults.fsi | 36 +++ src/Compiler/Symbols/Exprs.fs | 1 + 13 files changed, 630 insertions(+), 3 deletions(-) create mode 100644 fcs/build.sh create mode 100644 fcs/fcs-test/NuGet.config create mode 100644 fcs/fcs-test/Program.fs create mode 100644 fcs/fcs-test/ast_print.fs create mode 100644 fcs/fcs-test/fcs-test.fsproj create mode 100644 fcs/fcs-test/test_script.fsx create mode 100644 fcs/service_slim.fs diff --git a/.vscode/launch.json b/.vscode/launch.json index b93e358bbc1..d90f91a1c52 100644 --- a/.vscode/launch.json +++ b/.vscode/launch.json @@ -92,6 +92,16 @@ "enableStepFiltering": false, "requireExactSource": false, "allowFastEvaluate": true + }, + { + "name": "FCS Test", + "type": "coreclr", + "request": "launch", + "program": "${workspaceFolder}/artifacts/bin/fcs-test/Debug/net6.0/fcs-test.dll", + "args": [], + "cwd": "${workspaceFolder}/fcs/fcs-test", + "console": "internalConsole", + "stopAtEntry": false } ] -} +} \ No newline at end of file diff --git a/buildtools/buildtools.targets b/buildtools/buildtools.targets index 86346fc2a15..4cc7fe7a3a4 100644 --- a/buildtools/buildtools.targets +++ b/buildtools/buildtools.targets @@ -20,7 +20,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\Bootstrap\fslex\fslex.dll + $(ArtifactsDir)\bin\fslex\Release\net5.0\fslex.dll @@ -44,7 +44,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\Bootstrap\fsyacc\fsyacc.dll + $(ArtifactsDir)\bin\fsyacc\Release\net5.0\fsyacc.dll diff --git a/fcs/build.sh b/fcs/build.sh new file mode 100644 index 00000000000..d027a7f7acb --- /dev/null +++ b/fcs/build.sh @@ -0,0 +1,4 @@ +#!/usr/bin/env bash + +dotnet build -c Release src/buildtools/buildtools.proj +dotnet build -c Release src/fsharp/FSharp.Compiler.Service diff --git a/fcs/fcs-test/NuGet.config b/fcs/fcs-test/NuGet.config new file mode 100644 index 00000000000..273c7d2db75 --- /dev/null +++ b/fcs/fcs-test/NuGet.config @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/fcs/fcs-test/Program.fs b/fcs/fcs-test/Program.fs new file mode 100644 index 00000000000..83c6ab67ee2 --- /dev/null +++ b/fcs/fcs-test/Program.fs @@ -0,0 +1,124 @@ +open System.IO +open FSharp.Compiler +open FSharp.Compiler.CodeAnalysis +open FSharp.Compiler.SourceCodeServices +open FSharp.Compiler.EditorServices + +let getProjectOptions (folder: string) (projectFile: string) = + let runProcess (workingDir: string) (exePath: string) (args: string) = + let psi = System.Diagnostics.ProcessStartInfo() + psi.FileName <- exePath + psi.WorkingDirectory <- workingDir + psi.RedirectStandardOutput <- false + psi.RedirectStandardError <- false + psi.Arguments <- args + psi.CreateNoWindow <- true + psi.UseShellExecute <- false + + use p = new System.Diagnostics.Process() + p.StartInfo <- psi + p.Start() |> ignore + p.WaitForExit() + + let exitCode = p.ExitCode + exitCode, () + + let runCmd exePath args = runProcess folder exePath (args |> String.concat " ") + let msbuildExec = Dotnet.ProjInfo.Inspect.dotnetMsbuild runCmd + let result = Dotnet.ProjInfo.Inspect.getProjectInfo ignore msbuildExec Dotnet.ProjInfo.Inspect.getFscArgs projectFile + match result with + | Ok (Dotnet.ProjInfo.Inspect.GetResult.FscArgs x) -> x + | _ -> [] + +let mkStandardProjectReferences () = + let projFile = "fcs-test.fsproj" + let projDir = __SOURCE_DIRECTORY__ + getProjectOptions projDir projFile + |> List.filter (fun s -> s.StartsWith("-r:")) + |> List.map (fun s -> s.Replace("-r:", "")) + +let mkProjectCommandLineArgsForScript (dllName, fileNames) = + [| yield "--simpleresolution" + yield "--noframework" + yield "--debug:full" + yield "--define:DEBUG" + yield "--optimize-" + yield "--out:" + dllName + yield "--doc:test.xml" + yield "--warn:3" + yield "--fullpaths" + yield "--flaterrors" + yield "--target:library" + for x in fileNames do + yield x + let references = mkStandardProjectReferences () + for r in references do + yield "-r:" + r + |] + +let getProjectOptionsFromCommandLineArgs(projName, argv): FSharpProjectOptions = + { ProjectFileName = projName + ProjectId = None + SourceFiles = [| |] + OtherOptions = argv + ReferencedProjects = [| |] + IsIncompleteTypeCheckEnvironment = false + UseScriptResolutionRules = false + LoadTime = System.DateTime.MaxValue + UnresolvedReferences = None + OriginalLoadReferences = [] + Stamp = None } + +let printAst title (projectResults: FSharpCheckProjectResults) = + let implFiles = projectResults.AssemblyContents.ImplementationFiles + let decls = implFiles + |> Seq.collect (fun file -> AstPrint.printFSharpDecls "" file.Declarations) + |> String.concat "\n" + printfn "%s Typed AST:" title + decls |> printfn "%s" + +[] +let main argv = + let projName = "Project.fsproj" + let fileName = "test_script.fsx" + let fileNames = [| fileName |] + let source = File.ReadAllText (fileName, System.Text.Encoding.UTF8) + let sources = [| source |] + + let dllName = Path.ChangeExtension(fileName, ".dll") + let args = mkProjectCommandLineArgsForScript (dllName, fileNames) + // for arg in args do printfn "%s" arg + + let projectOptions = getProjectOptionsFromCommandLineArgs (projName, args) + let checker = InteractiveChecker.Create(projectOptions) + + // parse and typecheck a project + let sourceReader _key = (1, lazy source) + let projectResults = checker.ParseAndCheckProject(projName, fileNames, sourceReader) + projectResults.Diagnostics |> Array.iter (fun e -> printfn "%A: %A" (e.Severity) e) + printAst "ParseAndCheckProject" projectResults + + // or just parse and typecheck a file in project + let parseResults, typeCheckResults, projectResults = + checker.ParseAndCheckFileInProject(fileName, projName, fileNames, sources) + projectResults.Diagnostics |> Array.iter (fun e -> printfn "%A: %A" (e.Severity) e) + + printAst "ParseAndCheckFileInProject" projectResults + + let inputLines = source.Split('\n') + + // Get tool tip at the specified location + let tip = typeCheckResults.GetToolTip(4, 7, inputLines.[3], ["foo"], Tokenization.FSharpTokenTag.IDENT) + (sprintf "%A" tip).Replace("\n","") |> printfn "\n---> ToolTip Text = %A" // should print "FSharpToolTipText [...]" + + // Get declarations (autocomplete) for msg + let partialName = { QualifyingIdents = []; PartialIdent = "msg"; EndColumn = 17; LastDotPos = None } + let decls = typeCheckResults.GetDeclarationListInfo(Some parseResults, 6, inputLines.[5], partialName, (fun _ -> [])) + [ for item in decls.Items -> item.Name ] |> printfn "\n---> msg AutoComplete = %A" // should print string methods + + // Get declarations (autocomplete) for canvas + let partialName = { QualifyingIdents = []; PartialIdent = "canvas"; EndColumn = 10; LastDotPos = None } + let decls = typeCheckResults.GetDeclarationListInfo(Some parseResults, 8, inputLines.[7], partialName, (fun _ -> [])) + [ for item in decls.Items -> item.Name ] |> printfn "\n---> canvas AutoComplete = %A" + + 0 diff --git a/fcs/fcs-test/ast_print.fs b/fcs/fcs-test/ast_print.fs new file mode 100644 index 00000000000..747860e55b3 --- /dev/null +++ b/fcs/fcs-test/ast_print.fs @@ -0,0 +1,101 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +module AstPrint + +open FSharp.Compiler.Symbols + +//------------------------------------------------------------------------- +// AstPrint +//------------------------------------------------------------------------- + +let attribsOfSymbol (s: FSharpSymbol) = + [ match s with + | :? FSharpField as v -> + yield "field" + if v.IsCompilerGenerated then yield "compgen" + if v.IsDefaultValue then yield "default" + if v.IsMutable then yield "mutable" + if v.IsVolatile then yield "volatile" + if v.IsStatic then yield "static" + if v.IsLiteral then yield sprintf "%A" v.LiteralValue.Value + + | :? FSharpEntity as v -> + v.TryFullName |> ignore // check there is no failure here + match v.BaseType with + | Some t when t.HasTypeDefinition && t.TypeDefinition.TryFullName.IsSome -> + yield sprintf "inherits %s" t.TypeDefinition.FullName + | _ -> () + if v.IsNamespace then yield "namespace" + if v.IsFSharpModule then yield "module" + if v.IsByRef then yield "byref" + if v.IsClass then yield "class" + if v.IsDelegate then yield "delegate" + if v.IsEnum then yield "enum" + if v.IsFSharpAbbreviation then yield "abbrev" + if v.IsFSharpExceptionDeclaration then yield "exception" + if v.IsFSharpRecord then yield "record" + if v.IsFSharpUnion then yield "union" + if v.IsInterface then yield "interface" + if v.IsMeasure then yield "measure" +#if !NO_EXTENSIONTYPING + if v.IsProvided then yield "provided" + if v.IsStaticInstantiation then yield "static_inst" + if v.IsProvidedAndErased then yield "erased" + if v.IsProvidedAndGenerated then yield "generated" +#endif + if v.IsUnresolved then yield "unresolved" + if v.IsValueType then yield "valuetype" + + | :? FSharpMemberOrFunctionOrValue as v -> + yield "owner: " + match v.DeclaringEntity with | Some e -> e.CompiledName | _ -> "" + if v.IsActivePattern then yield "active_pattern" + if v.IsDispatchSlot then yield "dispatch_slot" + if v.IsModuleValueOrMember && not v.IsMember then yield "val" + if v.IsMember then yield "member" + if v.IsProperty then yield "property" + if v.IsExtensionMember then yield "extension_member" + if v.IsPropertyGetterMethod then yield "property_getter" + if v.IsPropertySetterMethod then yield "property_setter" + if v.IsEvent then yield "event" + if v.EventForFSharpProperty.IsSome then yield "property_event" + if v.IsEventAddMethod then yield "event_add" + if v.IsEventRemoveMethod then yield "event_remove" + if v.IsTypeFunction then yield "type_func" + if v.IsCompilerGenerated then yield "compiler_gen" + if v.IsImplicitConstructor then yield "implicit_ctor" + if v.IsMutable then yield "mutable" + if v.IsOverrideOrExplicitInterfaceImplementation then yield "override_impl" + if not v.IsInstanceMember then yield "static" + if v.IsInstanceMember && not v.IsInstanceMemberInCompiledCode && not v.IsExtensionMember then yield "funky" + if v.IsExplicitInterfaceImplementation then yield "interface_impl" + yield sprintf "%A" v.InlineAnnotation + // if v.IsConstructorThisValue then yield "ctorthis" + // if v.IsMemberThisValue then yield "this" + // if v.LiteralValue.IsSome then yield "literal" + | _ -> () ] + +let rec printFSharpDecls prefix decls = seq { + let mutable i = 0 + for decl in decls do + i <- i + 1 + match decl with + | FSharpImplementationFileDeclaration.Entity (e, sub) -> + yield sprintf "%s%i) ENTITY: %s %A" prefix i e.CompiledName (attribsOfSymbol e) + if not (Seq.isEmpty e.Attributes) then + yield sprintf "%sattributes: %A" prefix (Seq.toList e.Attributes) + if not (Seq.isEmpty e.DeclaredInterfaces) then + yield sprintf "%sinterfaces: %A" prefix (Seq.toList e.DeclaredInterfaces) + yield "" + yield! printFSharpDecls (prefix + "\t") sub + | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue (meth, args, body) -> + yield sprintf "%s%i) METHOD: %s %A" prefix i meth.CompiledName (attribsOfSymbol meth) + yield sprintf "%stype: %A" prefix meth.FullType + yield sprintf "%sargs: %A" prefix args + // if not meth.IsCompilerGenerated then + yield sprintf "%sbody: %A" prefix body + yield "" + | FSharpImplementationFileDeclaration.InitAction (expr) -> + yield sprintf "%s%i) ACTION" prefix i + yield sprintf "%s%A" prefix expr + yield "" +} diff --git a/fcs/fcs-test/fcs-test.fsproj b/fcs/fcs-test/fcs-test.fsproj new file mode 100644 index 00000000000..72ab6dba64e --- /dev/null +++ b/fcs/fcs-test/fcs-test.fsproj @@ -0,0 +1,26 @@ + + + + Exe + net6.0 + true + + + + + + + + + + + + + + + + + + + + diff --git a/fcs/fcs-test/test_script.fsx b/fcs/fcs-test/test_script.fsx new file mode 100644 index 00000000000..1bbe729ab75 --- /dev/null +++ b/fcs/fcs-test/test_script.fsx @@ -0,0 +1,8 @@ +open System +open Fable.Import + +let foo() = + let msg = String.Concat("Hello"," ","world") + let len = msg.Length + let canvas = Browser.document.createElement_canvas () + canvas.width <- 1000. diff --git a/fcs/service_slim.fs b/fcs/service_slim.fs new file mode 100644 index 00000000000..ef29396dbe5 --- /dev/null +++ b/fcs/service_slim.fs @@ -0,0 +1,303 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.SourceCodeServices + +open System +open System.Collections.Concurrent +open System.IO +open System.Threading + +open Internal.Utilities.Collections +open Internal.Utilities.Library +open Internal.Utilities.Library.Extras +open FSharp.Compiler +open FSharp.Compiler.AbstractIL +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.AbstractIL.ILBinaryReader +open FSharp.Compiler.CodeAnalysis +open FSharp.Compiler.CheckExpressions +open FSharp.Compiler.CheckDeclarations +open FSharp.Compiler.CompilerConfig +open FSharp.Compiler.CompilerDiagnostics +open FSharp.Compiler.CompilerGlobalState +open FSharp.Compiler.CompilerImports +open FSharp.Compiler.CompilerOptions +open FSharp.Compiler.DependencyManager +open FSharp.Compiler.Diagnostics +open FSharp.Compiler.Driver +open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.NameResolution +open FSharp.Compiler.ParseAndCheckInputs +open FSharp.Compiler.ScriptClosure +open FSharp.Compiler.Symbols +open FSharp.Compiler.Syntax +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.Text +open FSharp.Compiler.Text.Range +open FSharp.Compiler.Tokenization +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeBasics +open FSharp.Compiler.TypedTreeOps + +//------------------------------------------------------------------------- +// InteractiveChecker +//------------------------------------------------------------------------- + +type internal TcResult = TcEnv * TopAttribs * TypedImplFile option * ModuleOrNamespaceType +type internal TcErrors = FSharpDiagnostic[] + +type internal CompilerState = { + tcConfig: TcConfig + tcGlobals: TcGlobals + tcImports: TcImports + tcInitialState: TcState + projectOptions: FSharpProjectOptions + parseCache: ConcurrentDictionary + checkCache: ConcurrentDictionary +} + +// Cache to store current compiler state. +// In the case of type provider invalidation, +// compiler state needs to be reset to recognize TP changes. +type internal CompilerStateCache(projectOptions: FSharpProjectOptions) as this = + + let initializeCompilerState() = + let tcConfig = + let tcConfigB = + TcConfigBuilder.CreateNew(SimulatedMSBuildReferenceResolver.getResolver(), + defaultFSharpBinariesDir=FSharpCheckerResultsSettings.defaultFSharpBinariesDir, + reduceMemoryUsage=ReduceMemoryFlag.Yes, + implicitIncludeDir=Path.GetDirectoryName(projectOptions.ProjectFileName), + isInteractive=false, + isInvalidationSupported=true, + defaultCopyFSharpCore=CopyFSharpCoreFlag.No, + tryGetMetadataSnapshot=(fun _ -> None), + sdkDirOverride=None, + rangeForErrors=range0) + let sourceFiles = projectOptions.SourceFiles |> Array.toList + let argv = projectOptions.OtherOptions |> Array.toList + let _sourceFiles = ApplyCommandLineArgs(tcConfigB, sourceFiles, argv) + TcConfig.Create(tcConfigB, validate=false) + + let tcConfigP = TcConfigProvider.Constant(tcConfig) + + let ctok = CompilationThreadToken() + let dependencyProvider = new DependencyProvider() + let tcGlobals, tcImports = + TcImports.BuildTcImports (ctok, tcConfigP, dependencyProvider) + |> Cancellable.runWithoutCancellation + + // Handle type provider invalidation by resetting compiler state + tcImports.GetCcusExcludingBase() + |> Seq.iter (fun ccu -> + ccu.Deref.InvalidateEvent.Add(fun _ -> this.Reset()) + ) + + let niceNameGen = NiceNameGenerator() + let assemblyName = projectOptions.ProjectFileName |> Path.GetFileNameWithoutExtension + let tcInitialEnv = GetInitialTcEnv (assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) + let tcInitialState = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, niceNameGen, tcInitialEnv) + + // parse cache, keyed on file name and source hash + let parseCache = ConcurrentDictionary(HashIdentity.Structural) + // type check cache, keyed on file name + let checkCache = ConcurrentDictionary(HashIdentity.Structural) + + { + tcConfig = tcConfig + tcGlobals = tcGlobals + tcImports = tcImports + tcInitialState = tcInitialState + projectOptions = projectOptions + parseCache = parseCache + checkCache = checkCache + } + + // Lazily evaluated in case multiple TP invalidations are triggered before next compilation requested + let mutable compilerStateLazy = lazy initializeCompilerState() + let lockObj = obj() + + member x.Get() = + lock lockObj (fun () -> compilerStateLazy.Value) + member x.Reset() = + lock lockObj (fun () -> compilerStateLazy <- lazy initializeCompilerState()) + +[] +module internal ParseAndCheck = + + let userOpName = "Unknown" + let suggestNamesForErrors = true + + let MakeProjectResults (projectFileName: string, parseResults: FSharpParseFileResults[], tcState: TcState, errors: FSharpDiagnostic[], + symbolUses: TcSymbolUses list, topAttrsOpt: TopAttribs option, tcImplFilesOpt: TypedImplFile list option, + compilerState) = + let assemblyRef = mkSimpleAssemblyRef "stdin" + let assemblyDataOpt = None + let access = tcState.TcEnvFromImpls.AccessRights + let dependencyFiles = parseResults |> Seq.map (fun x -> x.DependencyFiles) |> Array.concat + let details = (compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, tcState.CcuSig, symbolUses, topAttrsOpt, + assemblyDataOpt, assemblyRef, access, tcImplFilesOpt, dependencyFiles, compilerState.projectOptions) + let keepAssemblyContents = true + FSharpCheckProjectResults (projectFileName, Some compilerState.tcConfig, keepAssemblyContents, errors, Some details) + + let ClearStaleCache (fileName: string, parsingOptions: FSharpParsingOptions, compilerState) = + let fileIndex = parsingOptions.SourceFiles |> Array.findIndex ((=) fileName) + let filesAbove = parsingOptions.SourceFiles |> Array.take fileIndex + // backup all cached typecheck entries above file + let cachedAbove = filesAbove |> Array.choose (fun key -> + match compilerState.checkCache.TryGetValue(key) with + | true, value -> Some (key, value) + | false, _ -> None) + // remove all parse cache entries with the same file name + let staleParseKeys = compilerState.parseCache.Keys |> Seq.filter (fun (n,_) -> n = fileName) |> Seq.toArray + staleParseKeys |> Array.iter (fun key -> compilerState.parseCache.TryRemove(key) |> ignore) + compilerState.checkCache.Clear(); // clear all typecheck cache + // restore all cached typecheck entries above file + cachedAbove |> Array.iter (fun (key, value) -> compilerState.checkCache.TryAdd(key, value) |> ignore) + + let ParseFile (fileName: string, sourceHash: int, source: Lazy, parsingOptions: FSharpParsingOptions, compilerState) = + let parseCacheKey = fileName, sourceHash + compilerState.parseCache.GetOrAdd(parseCacheKey, fun _ -> + ClearStaleCache(fileName, parsingOptions, compilerState) + let sourceText = SourceText.ofString source.Value + let parseErrors, parseTreeOpt, anyErrors = ParseAndCheckFile.parseFile (sourceText, fileName, parsingOptions, userOpName, suggestNamesForErrors) + let dependencyFiles = [||] // interactions have no dependencies + FSharpParseFileResults (parseErrors, parseTreeOpt, anyErrors, dependencyFiles) ) + + let TypeCheckOneInput (parseResults: FSharpParseFileResults, tcSink: TcResultsSink, tcState: TcState, moduleNamesDict: ModuleNamesDict, compilerState) = + let input = parseResults.ParseTree + let capturingErrorLogger = CompilationErrorLogger("TypeCheckFile", compilerState.tcConfig.errorSeverityOptions) + let errorLogger = GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput(input), capturingErrorLogger) + use _errorScope = new CompilationGlobalsScope (errorLogger, BuildPhase.TypeCheck) + + let checkForErrors () = parseResults.ParseHadErrors || errorLogger.ErrorCount > 0 + let prefixPathOpt = None + + let input, moduleNamesDict = input |> DeduplicateParsedInputModuleName moduleNamesDict + let tcResult, tcState = + TypeCheckOneInputEventually (checkForErrors, compilerState.tcConfig, compilerState.tcImports, compilerState.tcGlobals, prefixPathOpt, tcSink, tcState, input, false) + |> Eventually.force CancellationToken.None + |> function + | ValueOrCancelled.Value v -> v + | ValueOrCancelled.Cancelled ce -> raise ce // this condition is unexpected, since CancellationToken.None was passed + + let fileName = parseResults.FileName + let tcErrors = DiagnosticHelpers.CreateDiagnostics (compilerState.tcConfig.errorSeverityOptions, false, fileName, (capturingErrorLogger.GetDiagnostics()), suggestNamesForErrors) + (tcResult, tcErrors), (tcState, moduleNamesDict) + + let CheckFile (projectFileName: string, parseResults: FSharpParseFileResults, tcState: TcState, moduleNamesDict: ModuleNamesDict, compilerState) = + let sink = TcResultsSinkImpl(compilerState.tcGlobals) + let tcSink = TcResultsSink.WithSink sink + let (tcResult, tcErrors), (tcState, moduleNamesDict) = + TypeCheckOneInput (parseResults, tcSink, tcState, moduleNamesDict, compilerState) + let fileName = parseResults.FileName + compilerState.checkCache.[fileName] <- ((tcResult, tcErrors), (tcState, moduleNamesDict)) + + let loadClosure = None + let keepAssemblyContents = true + + let tcEnvAtEnd, _topAttrs, implFile, ccuSigForFile = tcResult + let errors = Array.append parseResults.Diagnostics tcErrors + + let scope = TypeCheckInfo (compilerState.tcConfig, compilerState.tcGlobals, ccuSigForFile, tcState.Ccu, compilerState.tcImports, tcEnvAtEnd.AccessRights, + projectFileName, fileName, compilerState.projectOptions, sink.GetResolutions(), sink.GetSymbolUses(), tcEnvAtEnd.NameEnv, + loadClosure, implFile, sink.GetOpenDeclarations()) + FSharpCheckFileResults (fileName, errors, Some scope, parseResults.DependencyFiles, None, keepAssemblyContents) + + let TypeCheckClosedInputSet (parseResults: FSharpParseFileResults[], tcState, compilerState) = + let cachedTypeCheck (tcState, moduleNamesDict) (parseRes: FSharpParseFileResults) = + let checkCacheKey = parseRes.FileName + let typeCheckOneInput _fileName = + TypeCheckOneInput (parseRes, TcResultsSink.NoSink, tcState, moduleNamesDict, compilerState) + compilerState.checkCache.GetOrAdd(checkCacheKey, typeCheckOneInput) + let results, (tcState, moduleNamesDict) = + ((tcState, Map.empty), parseResults) ||> Array.mapFold cachedTypeCheck + let tcResults, tcErrors = Array.unzip results + let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _ccuSigsForFiles), tcState = + TypeCheckMultipleInputsFinish(tcResults |> Array.toList, tcState) + let tcState, declaredImpls = TypeCheckClosedInputSetFinish (implFiles, tcState) + tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile, moduleNamesDict, tcErrors + + /// Errors grouped by file, sorted by line, column + let ErrorsByFile (fileNames: string[], errorList: FSharpDiagnostic[] list) = + let errorMap = errorList |> Array.concat |> Array.groupBy (fun x -> x.FileName) |> Map.ofArray + let errors = fileNames |> Array.choose errorMap.TryFind + errors |> Array.iter (Array.sortInPlaceBy (fun x -> x.StartLine, x.StartColumn)) + errors |> Array.concat + + +type InteractiveChecker internal (compilerStateCache) = + + static member Create(projectOptions: FSharpProjectOptions) = + InteractiveChecker(CompilerStateCache(projectOptions)) + + /// Clears parse and typecheck caches. + member _.ClearCache () = + let compilerState = compilerStateCache.Get() + compilerState.parseCache.Clear() + compilerState.checkCache.Clear() + + /// Parses and checks the whole project, good for compilers (Fable etc.) + /// Does not retain name resolutions and symbol uses which are quite memory hungry (so no intellisense etc.). + /// Already parsed files will be cached so subsequent compilations will be faster. + member _.ParseAndCheckProject (projectFileName: string, fileNames: string[], sourceReader: string->int*Lazy) = + let compilerState = compilerStateCache.Get() + // parse files + let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) + let parseResults = fileNames |> Array.map (fun fileName -> + let sourceHash, source = sourceReader fileName + ParseFile(fileName, sourceHash, source, parsingOptions, compilerState)) + + // type check files + let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, _moduleNamesDict, tcErrors = + TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState) + + // make project results + let parseErrors = parseResults |> Array.collect (fun p -> p.Diagnostics) + let typedErrors = tcErrors |> Array.concat + let errors = ErrorsByFile (fileNames, [ parseErrors; typedErrors ]) + let symbolUses = [] //TODO: + let projectResults = MakeProjectResults (projectFileName, parseResults, tcState, errors, symbolUses, Some topAttrs, Some tcImplFiles, compilerState) + + projectResults + + /// Parses and checks file in project, will compile and cache all the files up to this one + /// (if not already done before), or fetch them from cache. Returns partial project results, + /// up to and including the file requested. Returns parse and typecheck results containing + /// name resolutions and symbol uses for the file requested only, so intellisense etc. works. + member _.ParseAndCheckFileInProject (fileName: string, projectFileName: string, fileNames: string[], sources: string[]) = + let compilerState = compilerStateCache.Get() + // get files before file + let fileIndex = fileNames |> Array.findIndex ((=) fileName) + let fileNamesBeforeFile = fileNames |> Array.take fileIndex + let sourcesBeforeFile = sources |> Array.take fileIndex + + // parse files before file + let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) + let parseFile (fileName, source) = ParseFile (fileName, hash source, lazy source, parsingOptions, compilerState) + let parseResults = Array.zip fileNamesBeforeFile sourcesBeforeFile |> Array.map parseFile + + // type check files before file + let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, moduleNamesDict, tcErrors = + TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState) + + // parse and type check file + let parseFileResults = parseFile (fileName, sources.[fileIndex]) + let checkFileResults = CheckFile (projectFileName, parseFileResults, tcState, moduleNamesDict, compilerState) + let (tcResult, _tcErrors), (tcState, _moduleNamesDict) = compilerState.checkCache.[fileName] + let _tcEnvAtEndFile, topAttrsFile, implFile, _ccuSigForFile = tcResult + + // collect errors + let parseErrorsBefore = parseResults |> Array.collect (fun p -> p.Diagnostics) + let typedErrorsBefore = tcErrors |> Array.concat + let newErrors = checkFileResults.Diagnostics + let errors = ErrorsByFile (fileNames, [ parseErrorsBefore; typedErrorsBefore; newErrors ]) + + // make partial project results + let parseResults = Array.append parseResults [| parseFileResults |] + let tcImplFiles = List.append tcImplFiles (Option.toList implFile) + let topAttrs = CombineTopAttrs topAttrsFile topAttrs + let symbolUses = [] //TODO: + let projectResults = MakeProjectResults (projectFileName, parseResults, tcState, errors, symbolUses, Some topAttrs, Some tcImplFiles, compilerState) + + parseFileResults, checkFileResults, projectResults diff --git a/src/Compiler/Checking/QuotationTranslator.fs b/src/Compiler/Checking/QuotationTranslator.fs index d5daa377540..c51383419cd 100644 --- a/src/Compiler/Checking/QuotationTranslator.fs +++ b/src/Compiler/Checking/QuotationTranslator.fs @@ -248,8 +248,10 @@ and GetWitnessArgs cenv (env : QuotationTranslationEnv) m tps tyargs = let g = cenv.g if g.generateWitnesses && not env.suppressWitnesses then let witnessExprs = + try ConstraintSolver.CodegenWitnessesForTyparInst cenv.tcVal g cenv.amap m tps tyargs |> CommitOperationResult + with _ -> [] let env = { env with suppressWitnesses = true } witnessExprs |> List.map (fun arg -> match arg with diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index 419746af6c0..7104a85b578 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -554,6 +554,8 @@ + + diff --git a/src/Compiler/Service/FSharpCheckerResults.fsi b/src/Compiler/Service/FSharpCheckerResults.fsi index 6b0a7f49135..4f597407f35 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fsi +++ b/src/Compiler/Service/FSharpCheckerResults.fsi @@ -245,9 +245,45 @@ type public FSharpParsingOptions = static member internal FromTcConfigBuilder: tcConfigB: TcConfigBuilder * sourceFiles: string[] * isInteractive: bool -> FSharpParsingOptions +[] +type internal TypeCheckInfo = + internal new : + _sTcConfig: TcConfig * + g: TcGlobals * + ccuSigForFile: ModuleOrNamespaceType * + thisCcu: CcuThunk * + tcImports: TcImports * + tcAccessRights: AccessorDomain * + projectFileName: string * + mainInputFileName: string * + projectOptions: FSharpProjectOptions * + sResolutions: TcResolutions * + sSymbolUses: TcSymbolUses * + sFallback: NameResolutionEnv * + loadClosure: LoadClosure option * + implFileOpt: TypedImplFile option * + openDeclarations: OpenDeclaration[] + -> TypeCheckInfo + member ScopeResolutions: TcResolutions + member ScopeSymbolUses: TcSymbolUses + member TcGlobals: TcGlobals + member TcImports: TcImports + member CcuSigForFile: ModuleOrNamespaceType + member ThisCcu: CcuThunk + member ImplementationFile: TypedImplFile option + /// A handle to the results of CheckFileInProject. [] type public FSharpCheckFileResults = + internal new : + filename: string * + errors: FSharpDiagnostic[] * + scopeOptX: TypeCheckInfo option * + dependencyFiles: string[] * + builderX: IncrementalBuilder option * + keepAssemblyContents: bool + -> FSharpCheckFileResults + /// The errors returned by parsing a source file. member Diagnostics: FSharpDiagnostic[] diff --git a/src/Compiler/Symbols/Exprs.fs b/src/Compiler/Symbols/Exprs.fs index 91480597cc2..45586677de5 100644 --- a/src/Compiler/Symbols/Exprs.fs +++ b/src/Compiler/Symbols/Exprs.fs @@ -515,6 +515,7 @@ module FSharpExprConvert = // let inline HashChar (x:char) = (# "or" (# "shl" x 16 : int #) x : int #) // in FSharp.Core. | ErrorResult _ when vref.LogicalName = "op_LeftShift" && List.isSingleton tyargs -> [] + | ErrorResult (warns, err) -> ReportWarnings (err::warns); [] // temporary, ignores the error | res -> CommitOperationResult res let env = { env with suppressWitnesses = true } witnessExprs |> List.map (fun arg -> From 5fd19d4da3ff900e898c318e9bcb993ab61bfad0 Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Mon, 15 Nov 2021 15:35:48 -0800 Subject: [PATCH 02/13] Async ParseAndCheckProject by Alfonso --- fcs/build.sh | 1 + fcs/service_slim.fs | 207 ++++++++++++++++++++------------------------ 2 files changed, 96 insertions(+), 112 deletions(-) diff --git a/fcs/build.sh b/fcs/build.sh index d027a7f7acb..98855758986 100644 --- a/fcs/build.sh +++ b/fcs/build.sh @@ -2,3 +2,4 @@ dotnet build -c Release src/buildtools/buildtools.proj dotnet build -c Release src/fsharp/FSharp.Compiler.Service +#dotnet /usr/share/dotnet/sdk/5.0.402/MSBuild.dll /p:Configuration=Release /p:FscToolExe=fsc src/fsharp/FSharp.Compiler.Service/ diff --git a/fcs/service_slim.fs b/fcs/service_slim.fs index ef29396dbe5..ffeac9b08f4 100644 --- a/fcs/service_slim.fs +++ b/fcs/service_slim.fs @@ -38,6 +38,7 @@ open FSharp.Compiler.Tokenization open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.BuildGraph //------------------------------------------------------------------------- // InteractiveChecker @@ -56,12 +57,56 @@ type internal CompilerState = { checkCache: ConcurrentDictionary } -// Cache to store current compiler state. -// In the case of type provider invalidation, -// compiler state needs to be reset to recognize TP changes. -type internal CompilerStateCache(projectOptions: FSharpProjectOptions) as this = +type internal CacheMsg<'T> = + | Get of AsyncReplyChannel<'T> + | Reset + +type internal Cache<'T>(init: (unit -> unit) -> Async<'T>) = + let agent = + MailboxProcessor>.Start(fun agent -> + let rec loop cached = async { + match! agent.Receive() with + | Get channel -> + match cached with + | Some cached -> + channel.Reply(cached) + return! Some cached |> loop + | None -> + let reset() = agent.Post Reset + let! cached = init reset + channel.Reply cached + return! Some cached |> loop + | Reset -> + return! loop None + } + + loop None) + member _.Get() = agent.PostAndAsyncReply(Get) + member _.Reset() = agent.Post Reset - let initializeCompilerState() = +[] +module internal ParseAndCheck = + + let userOpName = "Unknown" + let suggestNamesForErrors = true + + let measureTime (f: unit -> 'a) = + let sw = Diagnostics.Stopwatch.StartNew() + let res = f() + sw.Stop() + res, sw.ElapsedMilliseconds + + let measureTimeAsync (f: unit -> Async<'a>) = async { + let sw = Diagnostics.Stopwatch.StartNew() + let! res = f() + sw.Stop() + return res, sw.ElapsedMilliseconds + } + + // Cache to store current compiler state. + // In the case of type provider invalidation, + // compiler state needs to be reset to recognize TP changes. + let initializeCompilerState projectOptions reset = async { let tcConfig = let tcConfigB = TcConfigBuilder.CreateNew(SimulatedMSBuildReferenceResolver.getResolver(), @@ -81,29 +126,28 @@ type internal CompilerStateCache(projectOptions: FSharpProjectOptions) as this = let tcConfigP = TcConfigProvider.Constant(tcConfig) - let ctok = CompilationThreadToken() let dependencyProvider = new DependencyProvider() - let tcGlobals, tcImports = - TcImports.BuildTcImports (ctok, tcConfigP, dependencyProvider) - |> Cancellable.runWithoutCancellation + let! tcGlobals, tcImports = + TcImports.BuildTcImports (tcConfigP, dependencyProvider) + |> Async.AwaitNodeCode // Handle type provider invalidation by resetting compiler state tcImports.GetCcusExcludingBase() |> Seq.iter (fun ccu -> - ccu.Deref.InvalidateEvent.Add(fun _ -> this.Reset()) + ccu.Deref.InvalidateEvent.Add(fun _ -> reset()) ) let niceNameGen = NiceNameGenerator() let assemblyName = projectOptions.ProjectFileName |> Path.GetFileNameWithoutExtension - let tcInitialEnv = GetInitialTcEnv (assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) - let tcInitialState = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, niceNameGen, tcInitialEnv) + let tcInitial, openDecls0 = GetInitialTcEnv (assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) + let tcInitialState = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, niceNameGen, tcInitial, openDecls0) // parse cache, keyed on file name and source hash let parseCache = ConcurrentDictionary(HashIdentity.Structural) // type check cache, keyed on file name let checkCache = ConcurrentDictionary(HashIdentity.Structural) - { + return { tcConfig = tcConfig tcGlobals = tcGlobals tcImports = tcImports @@ -112,31 +156,16 @@ type internal CompilerStateCache(projectOptions: FSharpProjectOptions) as this = parseCache = parseCache checkCache = checkCache } - - // Lazily evaluated in case multiple TP invalidations are triggered before next compilation requested - let mutable compilerStateLazy = lazy initializeCompilerState() - let lockObj = obj() - - member x.Get() = - lock lockObj (fun () -> compilerStateLazy.Value) - member x.Reset() = - lock lockObj (fun () -> compilerStateLazy <- lazy initializeCompilerState()) - -[] -module internal ParseAndCheck = - - let userOpName = "Unknown" - let suggestNamesForErrors = true + } let MakeProjectResults (projectFileName: string, parseResults: FSharpParseFileResults[], tcState: TcState, errors: FSharpDiagnostic[], - symbolUses: TcSymbolUses list, topAttrsOpt: TopAttribs option, tcImplFilesOpt: TypedImplFile list option, + topAttrsOpt: TopAttribs option, tcImplFilesOpt: TypedImplFile list option, compilerState) = let assemblyRef = mkSimpleAssemblyRef "stdin" - let assemblyDataOpt = None let access = tcState.TcEnvFromImpls.AccessRights let dependencyFiles = parseResults |> Seq.map (fun x -> x.DependencyFiles) |> Array.concat - let details = (compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, tcState.CcuSig, symbolUses, topAttrsOpt, - assemblyDataOpt, assemblyRef, access, tcImplFilesOpt, dependencyFiles, compilerState.projectOptions) + let details = (compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, tcState.CcuSig, (Choice2Of2 TcSymbolUses.Empty), topAttrsOpt, + assemblyRef, access, tcImplFilesOpt, dependencyFiles, compilerState.projectOptions) let keepAssemblyContents = true FSharpCheckProjectResults (projectFileName, Some compilerState.tcConfig, keepAssemblyContents, errors, Some details) @@ -164,7 +193,7 @@ module internal ParseAndCheck = let dependencyFiles = [||] // interactions have no dependencies FSharpParseFileResults (parseErrors, parseTreeOpt, anyErrors, dependencyFiles) ) - let TypeCheckOneInput (parseResults: FSharpParseFileResults, tcSink: TcResultsSink, tcState: TcState, moduleNamesDict: ModuleNamesDict, compilerState) = + let TypeCheckOneInputEntry (parseResults: FSharpParseFileResults, tcSink: TcResultsSink, tcState: TcState, moduleNamesDict: ModuleNamesDict, compilerState) = let input = parseResults.ParseTree let capturingErrorLogger = CompilationErrorLogger("TypeCheckFile", compilerState.tcConfig.errorSeverityOptions) let errorLogger = GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput(input), capturingErrorLogger) @@ -175,47 +204,29 @@ module internal ParseAndCheck = let input, moduleNamesDict = input |> DeduplicateParsedInputModuleName moduleNamesDict let tcResult, tcState = - TypeCheckOneInputEventually (checkForErrors, compilerState.tcConfig, compilerState.tcImports, compilerState.tcGlobals, prefixPathOpt, tcSink, tcState, input, false) - |> Eventually.force CancellationToken.None - |> function - | ValueOrCancelled.Value v -> v - | ValueOrCancelled.Cancelled ce -> raise ce // this condition is unexpected, since CancellationToken.None was passed + TypeCheckOneInput (checkForErrors, compilerState.tcConfig, compilerState.tcImports, compilerState.tcGlobals, prefixPathOpt, tcSink, tcState, input, false) + |> Cancellable.runWithoutCancellation let fileName = parseResults.FileName let tcErrors = DiagnosticHelpers.CreateDiagnostics (compilerState.tcConfig.errorSeverityOptions, false, fileName, (capturingErrorLogger.GetDiagnostics()), suggestNamesForErrors) (tcResult, tcErrors), (tcState, moduleNamesDict) - let CheckFile (projectFileName: string, parseResults: FSharpParseFileResults, tcState: TcState, moduleNamesDict: ModuleNamesDict, compilerState) = - let sink = TcResultsSinkImpl(compilerState.tcGlobals) - let tcSink = TcResultsSink.WithSink sink - let (tcResult, tcErrors), (tcState, moduleNamesDict) = - TypeCheckOneInput (parseResults, tcSink, tcState, moduleNamesDict, compilerState) - let fileName = parseResults.FileName - compilerState.checkCache.[fileName] <- ((tcResult, tcErrors), (tcState, moduleNamesDict)) - - let loadClosure = None - let keepAssemblyContents = true - - let tcEnvAtEnd, _topAttrs, implFile, ccuSigForFile = tcResult - let errors = Array.append parseResults.Diagnostics tcErrors - - let scope = TypeCheckInfo (compilerState.tcConfig, compilerState.tcGlobals, ccuSigForFile, tcState.Ccu, compilerState.tcImports, tcEnvAtEnd.AccessRights, - projectFileName, fileName, compilerState.projectOptions, sink.GetResolutions(), sink.GetSymbolUses(), tcEnvAtEnd.NameEnv, - loadClosure, implFile, sink.GetOpenDeclarations()) - FSharpCheckFileResults (fileName, errors, Some scope, parseResults.DependencyFiles, None, keepAssemblyContents) - let TypeCheckClosedInputSet (parseResults: FSharpParseFileResults[], tcState, compilerState) = let cachedTypeCheck (tcState, moduleNamesDict) (parseRes: FSharpParseFileResults) = let checkCacheKey = parseRes.FileName let typeCheckOneInput _fileName = - TypeCheckOneInput (parseRes, TcResultsSink.NoSink, tcState, moduleNamesDict, compilerState) + TypeCheckOneInputEntry (parseRes, TcResultsSink.NoSink, tcState, moduleNamesDict, compilerState) compilerState.checkCache.GetOrAdd(checkCacheKey, typeCheckOneInput) + let results, (tcState, moduleNamesDict) = ((tcState, Map.empty), parseResults) ||> Array.mapFold cachedTypeCheck + let tcResults, tcErrors = Array.unzip results let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _ccuSigsForFiles), tcState = TypeCheckMultipleInputsFinish(tcResults |> Array.toList, tcState) - let tcState, declaredImpls = TypeCheckClosedInputSetFinish (implFiles, tcState) + + let tcState, declaredImpls, ccuContents = TypeCheckClosedInputSetFinish (implFiles, tcState) + tcState.Ccu.Deref.Contents <- ccuContents tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile, moduleNamesDict, tcErrors /// Errors grouped by file, sorted by line, column @@ -229,75 +240,47 @@ module internal ParseAndCheck = type InteractiveChecker internal (compilerStateCache) = static member Create(projectOptions: FSharpProjectOptions) = - InteractiveChecker(CompilerStateCache(projectOptions)) + Cache(initializeCompilerState projectOptions) |> InteractiveChecker /// Clears parse and typecheck caches. - member _.ClearCache () = - let compilerState = compilerStateCache.Get() + member _.ClearCache () = async { + let! compilerState = compilerStateCache.Get() compilerState.parseCache.Clear() compilerState.checkCache.Clear() + } /// Parses and checks the whole project, good for compilers (Fable etc.) /// Does not retain name resolutions and symbol uses which are quite memory hungry (so no intellisense etc.). /// Already parsed files will be cached so subsequent compilations will be faster. - member _.ParseAndCheckProject (projectFileName: string, fileNames: string[], sourceReader: string->int*Lazy) = - let compilerState = compilerStateCache.Get() + member _.ParseAndCheckProject (projectFileName: string, fileNames: string[], sourceReader: string->int*Lazy, ?lastFile: string) = async { + let! compilerState = compilerStateCache.Get() // parse files let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) - let parseResults = fileNames |> Array.map (fun fileName -> - let sourceHash, source = sourceReader fileName - ParseFile(fileName, sourceHash, source, parsingOptions, compilerState)) + // We can paralellize this, but only in the first compilation because later it causes issues when invalidating the cache + let parseResults = // measureTime <| fun _ -> + let fileNames = + match lastFile with + | None -> fileNames + | Some fileName -> + let fileIndex = fileNames |> Array.findIndex ((=) fileName) + fileNames |> Array.take (fileIndex + 1) + + fileNames |> Array.map (fun fileName -> + let sourceHash, source = sourceReader fileName + ParseFile(fileName, sourceHash, source, parsingOptions, compilerState) + ) + // printfn "FCS: Parsing finished in %ims" ms // type check files - let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, _moduleNamesDict, tcErrors = + let (tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, _moduleNamesDict, tcErrors) = // measureTime <| fun _ -> TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState) + // printfn "FCS: Checking finished in %ims" ms // make project results let parseErrors = parseResults |> Array.collect (fun p -> p.Diagnostics) let typedErrors = tcErrors |> Array.concat let errors = ErrorsByFile (fileNames, [ parseErrors; typedErrors ]) - let symbolUses = [] //TODO: - let projectResults = MakeProjectResults (projectFileName, parseResults, tcState, errors, symbolUses, Some topAttrs, Some tcImplFiles, compilerState) - - projectResults - - /// Parses and checks file in project, will compile and cache all the files up to this one - /// (if not already done before), or fetch them from cache. Returns partial project results, - /// up to and including the file requested. Returns parse and typecheck results containing - /// name resolutions and symbol uses for the file requested only, so intellisense etc. works. - member _.ParseAndCheckFileInProject (fileName: string, projectFileName: string, fileNames: string[], sources: string[]) = - let compilerState = compilerStateCache.Get() - // get files before file - let fileIndex = fileNames |> Array.findIndex ((=) fileName) - let fileNamesBeforeFile = fileNames |> Array.take fileIndex - let sourcesBeforeFile = sources |> Array.take fileIndex - - // parse files before file - let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) - let parseFile (fileName, source) = ParseFile (fileName, hash source, lazy source, parsingOptions, compilerState) - let parseResults = Array.zip fileNamesBeforeFile sourcesBeforeFile |> Array.map parseFile - - // type check files before file - let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, moduleNamesDict, tcErrors = - TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState) + let projectResults = MakeProjectResults (projectFileName, parseResults, tcState, errors, Some topAttrs, Some tcImplFiles, compilerState) - // parse and type check file - let parseFileResults = parseFile (fileName, sources.[fileIndex]) - let checkFileResults = CheckFile (projectFileName, parseFileResults, tcState, moduleNamesDict, compilerState) - let (tcResult, _tcErrors), (tcState, _moduleNamesDict) = compilerState.checkCache.[fileName] - let _tcEnvAtEndFile, topAttrsFile, implFile, _ccuSigForFile = tcResult - - // collect errors - let parseErrorsBefore = parseResults |> Array.collect (fun p -> p.Diagnostics) - let typedErrorsBefore = tcErrors |> Array.concat - let newErrors = checkFileResults.Diagnostics - let errors = ErrorsByFile (fileNames, [ parseErrorsBefore; typedErrorsBefore; newErrors ]) - - // make partial project results - let parseResults = Array.append parseResults [| parseFileResults |] - let tcImplFiles = List.append tcImplFiles (Option.toList implFile) - let topAttrs = CombineTopAttrs topAttrsFile topAttrs - let symbolUses = [] //TODO: - let projectResults = MakeProjectResults (projectFileName, parseResults, tcState, errors, symbolUses, Some topAttrs, Some tcImplFiles, compilerState) - - parseFileResults, checkFileResults, projectResults + return projectResults + } From 2bf82a8e3122e356afcc2b7e3bc8ac54ac8429ce Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Mon, 15 Nov 2021 15:51:59 -0800 Subject: [PATCH 03/13] Added ParseAndCheckFileInProject --- fcs/fcs-test/Program.fs | 12 +++++--- fcs/service_slim.fs | 67 +++++++++++++++++++++++++++++++++++++++-- 2 files changed, 72 insertions(+), 7 deletions(-) diff --git a/fcs/fcs-test/Program.fs b/fcs/fcs-test/Program.fs index 83c6ab67ee2..2cada0cbbd6 100644 --- a/fcs/fcs-test/Program.fs +++ b/fcs/fcs-test/Program.fs @@ -83,7 +83,6 @@ let main argv = let fileName = "test_script.fsx" let fileNames = [| fileName |] let source = File.ReadAllText (fileName, System.Text.Encoding.UTF8) - let sources = [| source |] let dllName = Path.ChangeExtension(fileName, ".dll") let args = mkProjectCommandLineArgsForScript (dllName, fileNames) @@ -91,16 +90,19 @@ let main argv = let projectOptions = getProjectOptionsFromCommandLineArgs (projName, args) let checker = InteractiveChecker.Create(projectOptions) + let sourceReader _fileName = (hash source, lazy source) // parse and typecheck a project - let sourceReader _key = (1, lazy source) - let projectResults = checker.ParseAndCheckProject(projName, fileNames, sourceReader) + let projectResults = + checker.ParseAndCheckProject(projName, fileNames, sourceReader) + |> Async.RunSynchronously projectResults.Diagnostics |> Array.iter (fun e -> printfn "%A: %A" (e.Severity) e) printAst "ParseAndCheckProject" projectResults // or just parse and typecheck a file in project - let parseResults, typeCheckResults, projectResults = - checker.ParseAndCheckFileInProject(fileName, projName, fileNames, sources) + let (parseResults, typeCheckResults, projectResults) = + checker.ParseAndCheckFileInProject(projName, fileNames, sourceReader, fileName) + |> Async.RunSynchronously projectResults.Diagnostics |> Array.iter (fun e -> printfn "%A: %A" (e.Severity) e) printAst "ParseAndCheckFileInProject" projectResults diff --git a/fcs/service_slim.fs b/fcs/service_slim.fs index ffeac9b08f4..b4159adc790 100644 --- a/fcs/service_slim.fs +++ b/fcs/service_slim.fs @@ -163,8 +163,9 @@ module internal ParseAndCheck = compilerState) = let assemblyRef = mkSimpleAssemblyRef "stdin" let access = tcState.TcEnvFromImpls.AccessRights + let symbolUses = Choice2Of2 TcSymbolUses.Empty let dependencyFiles = parseResults |> Seq.map (fun x -> x.DependencyFiles) |> Array.concat - let details = (compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, tcState.CcuSig, (Choice2Of2 TcSymbolUses.Empty), topAttrsOpt, + let details = (compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, tcState.CcuSig, symbolUses, topAttrsOpt, assemblyRef, access, tcImplFilesOpt, dependencyFiles, compilerState.projectOptions) let keepAssemblyContents = true FSharpCheckProjectResults (projectFileName, Some compilerState.tcConfig, keepAssemblyContents, errors, Some details) @@ -211,6 +212,25 @@ module internal ParseAndCheck = let tcErrors = DiagnosticHelpers.CreateDiagnostics (compilerState.tcConfig.errorSeverityOptions, false, fileName, (capturingErrorLogger.GetDiagnostics()), suggestNamesForErrors) (tcResult, tcErrors), (tcState, moduleNamesDict) + let CheckFile (projectFileName: string, parseResults: FSharpParseFileResults, tcState: TcState, moduleNamesDict: ModuleNamesDict, compilerState) = + let sink = TcResultsSinkImpl(compilerState.tcGlobals) + let tcSink = TcResultsSink.WithSink sink + let (tcResult, tcErrors), (tcState, moduleNamesDict) = + TypeCheckOneInputEntry (parseResults, tcSink, tcState, moduleNamesDict, compilerState) + let fileName = parseResults.FileName + compilerState.checkCache.[fileName] <- ((tcResult, tcErrors), (tcState, moduleNamesDict)) + + let loadClosure = None + let keepAssemblyContents = true + + let tcEnvAtEnd, _topAttrs, implFile, ccuSigForFile = tcResult + let errors = Array.append parseResults.Diagnostics tcErrors + + let scope = TypeCheckInfo (compilerState.tcConfig, compilerState.tcGlobals, ccuSigForFile, tcState.Ccu, compilerState.tcImports, tcEnvAtEnd.AccessRights, + projectFileName, fileName, compilerState.projectOptions, sink.GetResolutions(), sink.GetSymbolUses(), tcEnvAtEnd.NameEnv, + loadClosure, implFile, sink.GetOpenDeclarations()) + FSharpCheckFileResults (fileName, errors, Some scope, parseResults.DependencyFiles, None, keepAssemblyContents) + let TypeCheckClosedInputSet (parseResults: FSharpParseFileResults[], tcState, compilerState) = let cachedTypeCheck (tcState, moduleNamesDict) (parseRes: FSharpParseFileResults) = let checkCacheKey = parseRes.FileName @@ -252,7 +272,7 @@ type InteractiveChecker internal (compilerStateCache) = /// Parses and checks the whole project, good for compilers (Fable etc.) /// Does not retain name resolutions and symbol uses which are quite memory hungry (so no intellisense etc.). /// Already parsed files will be cached so subsequent compilations will be faster. - member _.ParseAndCheckProject (projectFileName: string, fileNames: string[], sourceReader: string->int*Lazy, ?lastFile: string) = async { + member _.ParseAndCheckProject (projectFileName: string, fileNames: string[], sourceReader: string -> int * Lazy, ?lastFile: string) = async { let! compilerState = compilerStateCache.Get() // parse files let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) @@ -284,3 +304,46 @@ type InteractiveChecker internal (compilerStateCache) = return projectResults } + + /// Parses and checks file in project, will compile and cache all the files up to this one + /// (if not already done before), or fetch them from cache. Returns partial project results, + /// up to and including the file requested. Returns parse and typecheck results containing + /// name resolutions and symbol uses for the file requested only, so intellisense etc. works. + member _.ParseAndCheckFileInProject (projectFileName: string, fileNames: string[], sourceReader: string -> int * Lazy, fileName: string) = async { + let! compilerState = compilerStateCache.Get() + + // get files before file + let fileIndex = fileNames |> Array.findIndex ((=) fileName) + let fileNamesBeforeFile = fileNames |> Array.take fileIndex + + // parse files before file + let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) + let parseFile fileName = + let sourceHash, source = sourceReader fileName + ParseFile (fileName, sourceHash, source, parsingOptions, compilerState) + let parseResults = fileNamesBeforeFile |> Array.map parseFile + + // type check files before file + let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, moduleNamesDict, tcErrors = + TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState) + + // parse and type check file + let parseFileResults = parseFile fileName + let checkFileResults = CheckFile (projectFileName, parseFileResults, tcState, moduleNamesDict, compilerState) + let (tcResult, _tcErrors), (tcState, _moduleNamesDict) = compilerState.checkCache.[fileName] + let _tcEnvAtEndFile, topAttrsFile, implFile, _ccuSigForFile = tcResult + + // collect errors + let parseErrorsBefore = parseResults |> Array.collect (fun p -> p.Diagnostics) + let typedErrorsBefore = tcErrors |> Array.concat + let newErrors = checkFileResults.Diagnostics + let errors = ErrorsByFile (fileNames, [ parseErrorsBefore; typedErrorsBefore; newErrors ]) + + // make partial project results + let parseResults = Array.append parseResults [| parseFileResults |] + let tcImplFiles = List.append tcImplFiles (Option.toList implFile) + let topAttrs = CombineTopAttrs topAttrsFile topAttrs + let projectResults = MakeProjectResults (projectFileName, parseResults, tcState, errors, Some topAttrs, Some tcImplFiles, compilerState) + + return (parseFileResults, checkFileResults, projectResults) + } From 64069195727882528ecba4ae60e187ff09ce6146 Mon Sep 17 00:00:00 2001 From: Alfonso Garcia-Caro Date: Thu, 23 Dec 2021 23:59:13 +0900 Subject: [PATCH 04/13] Add Compile to service_slim and pub-sub pattern --- fcs/service_slim.fs | 71 ++++++++++++++++++++++++++------ src/Compiler/Driver/fsc.fs | 17 ++++++++ src/Compiler/Service/service.fsi | 6 +++ 3 files changed, 82 insertions(+), 12 deletions(-) diff --git a/fcs/service_slim.fs b/fcs/service_slim.fs index b4159adc790..2d6c2bc86a0 100644 --- a/fcs/service_slim.fs +++ b/fcs/service_slim.fs @@ -110,6 +110,9 @@ module internal ParseAndCheck = let tcConfig = let tcConfigB = TcConfigBuilder.CreateNew(SimulatedMSBuildReferenceResolver.getResolver(), + includewin32manifest=false, + framework=false, + portablePDB=false, defaultFSharpBinariesDir=FSharpCheckerResultsSettings.defaultFSharpBinariesDir, reduceMemoryUsage=ReduceMemoryFlag.Yes, implicitIncludeDir=Path.GetDirectoryName(projectOptions.ProjectFileName), @@ -231,12 +234,23 @@ module internal ParseAndCheck = loadClosure, implFile, sink.GetOpenDeclarations()) FSharpCheckFileResults (fileName, errors, Some scope, parseResults.DependencyFiles, None, keepAssemblyContents) - let TypeCheckClosedInputSet (parseResults: FSharpParseFileResults[], tcState, compilerState) = + let TypeCheckClosedInputSet (parseResults: FSharpParseFileResults[], tcState, compilerState, subscriber) = let cachedTypeCheck (tcState, moduleNamesDict) (parseRes: FSharpParseFileResults) = let checkCacheKey = parseRes.FileName + let typeCheckOneInput _fileName = TypeCheckOneInputEntry (parseRes, TcResultsSink.NoSink, tcState, moduleNamesDict, compilerState) - compilerState.checkCache.GetOrAdd(checkCacheKey, typeCheckOneInput) + + let (result, errors), (tcState, moduleNamesDict) = compilerState.checkCache.GetOrAdd(checkCacheKey, typeCheckOneInput) + + let _, _, implFile, _ = result + match subscriber, implFile with + | Some subscriber, Some implFile -> + let cenv = SymbolEnv(compilerState.tcGlobals, tcState.Ccu, Some tcState.CcuSig, compilerState.tcImports) + FSharpImplementationFileContents(cenv, implFile) |> subscriber + | _ -> () + + (result, errors), (tcState, moduleNamesDict) let results, (tcState, moduleNamesDict) = ((tcState, Map.empty), parseResults) ||> Array.mapFold cachedTypeCheck @@ -256,7 +270,6 @@ module internal ParseAndCheck = errors |> Array.iter (Array.sortInPlaceBy (fun x -> x.StartLine, x.StartColumn)) errors |> Array.concat - type InteractiveChecker internal (compilerStateCache) = static member Create(projectOptions: FSharpProjectOptions) = @@ -269,15 +282,46 @@ type InteractiveChecker internal (compilerStateCache) = compilerState.checkCache.Clear() } + member _.GetImportedAssemblies() = async { + let! compilerState = compilerStateCache.Get() + let tcImports = compilerState.tcImports + let tcGlobals = compilerState.tcGlobals + return + tcImports.GetImportedAssemblies() + |> List.map (fun x -> FSharpAssembly(tcGlobals, tcImports, x.FSharpViewOfMetadata)) + } + + /// Compile project to file. If project has already been type checked, + /// check results will be taken from the cache. + member _.Compile(fileNames: string[], sourceReader: string -> int * Lazy, outFile: string) = async { + let! compilerState = compilerStateCache.Get() + let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) + let parseResults = fileNames |> Array.map (fun fileName -> + let sourceHash, source = sourceReader fileName + ParseFile(fileName, sourceHash, source, parsingOptions, compilerState)) + + let (tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, _moduleNamesDict, _tcErrors) = + TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState, None) + + let ctok = CompilationThreadToken() + let errors, errorLogger, _loggerProvider = CompileHelpers.mkCompilationErrorHandlers() + let exitCode = + CompileHelpers.tryCompile errorLogger (fun exiter -> + compileOfTypedAst (ctok, compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, + tcImplFiles, topAttrs, compilerState.tcConfig, outFile, errorLogger, exiter)) + + return errors.ToArray(), exitCode + } + /// Parses and checks the whole project, good for compilers (Fable etc.) /// Does not retain name resolutions and symbol uses which are quite memory hungry (so no intellisense etc.). /// Already parsed files will be cached so subsequent compilations will be faster. - member _.ParseAndCheckProject (projectFileName: string, fileNames: string[], sourceReader: string -> int * Lazy, ?lastFile: string) = async { + member _.ParseAndCheckProject (projectFileName: string, fileNames: string[], sourceReader: string -> int * Lazy, + ?lastFile: string, ?subscriber: FSharpImplementationFileContents -> unit) = async { let! compilerState = compilerStateCache.Get() // parse files let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) - // We can paralellize this, but only in the first compilation because later it causes issues when invalidating the cache - let parseResults = // measureTime <| fun _ -> + let parseResults = let fileNames = match lastFile with | None -> fileNames @@ -285,16 +329,19 @@ type InteractiveChecker internal (compilerStateCache) = let fileIndex = fileNames |> Array.findIndex ((=) fileName) fileNames |> Array.take (fileIndex + 1) - fileNames |> Array.map (fun fileName -> + let parseFile fileName = let sourceHash, source = sourceReader fileName ParseFile(fileName, sourceHash, source, parsingOptions, compilerState) - ) - // printfn "FCS: Parsing finished in %ims" ms + + // Don't parallelize if we have cached files, as it would create issues with invalidation + if compilerState.parseCache.Count = 0 then + fileNames |> Array.Parallel.map parseFile + else + fileNames |> Array.map parseFile // type check files let (tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, _moduleNamesDict, tcErrors) = // measureTime <| fun _ -> - TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState) - // printfn "FCS: Checking finished in %ims" ms + TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState, subscriber) // make project results let parseErrors = parseResults |> Array.collect (fun p -> p.Diagnostics) @@ -325,7 +372,7 @@ type InteractiveChecker internal (compilerStateCache) = // type check files before file let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, moduleNamesDict, tcErrors = - TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState) + TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState, None) // parse and type check file let parseFileResults = parseFile fileName diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 1d17950a9ac..e443595f4ff 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -1263,3 +1263,20 @@ let CompileFromCommandLineArguments |> main4 (tcImportsCapture, dynamicAssemblyCreator) |> main5 |> main6 dynamicAssemblyCreator + +let compileOfTypedAst + (ctok, tcGlobals, tcImports: TcImports, generatedCcu: CcuThunk, typedImplFiles, + topAttrs, tcConfig: TcConfig, outfile, errorLogger, exiter: Exiter) = + + let tcImportsCapture = None + let dynamicAssemblyCreator = None + let assemblyName = Path.GetFileNameWithoutExtension(outfile) + // Doubling here tcImports as frameworkTcImports, seems to work... + let frameworkTcImports = tcImports + + Args (ctok, tcGlobals, tcImports, frameworkTcImports, generatedCcu, typedImplFiles, topAttrs, tcConfig, outfile, None, assemblyName, errorLogger, exiter) + |> main2 + |> main3 + |> main4 (tcImportsCapture, dynamicAssemblyCreator) + |> main5 + |> main6 dynamicAssemblyCreator diff --git a/src/Compiler/Service/service.fsi b/src/Compiler/Service/service.fsi index 3e4fde2229c..114e384bef0 100644 --- a/src/Compiler/Service/service.fsi +++ b/src/Compiler/Service/service.fsi @@ -18,6 +18,12 @@ open FSharp.Compiler.Symbols open FSharp.Compiler.Syntax open FSharp.Compiler.Text open FSharp.Compiler.Tokenization +open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Driver + +module internal CompileHelpers = + val mkCompilationErrorHandlers: unit -> ResizeArray * ErrorLogger * ErrorLoggerProvider + val tryCompile: ErrorLogger -> (Exiter -> unit) -> int /// Used to parse and check F# source code. [] From a1517819b58b2a347eb2e1a506e43d188c84bdf7 Mon Sep 17 00:00:00 2001 From: Alfonso Garcia-Caro Date: Wed, 8 Jun 2022 11:46:11 +0900 Subject: [PATCH 05/13] Disable CheckInlineValueIsComplete for Fable (#10) --- src/Compiler/Optimize/Optimizer.fs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs index 51d889f5691..8d22f3af4f4 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -499,10 +499,18 @@ let rec IsPartialExprVal x = | ValValue (_, a) | SizeValue (_, a) -> IsPartialExprVal a +#if FABLE_CLI +// Many Fable packages inline functions that access internal values to resolve generics, this is not an issue +// in "normal" Fable compilations but it raises errors when generating an assembly por precompilation. Disable +// for Fable as it's not an actual error (and if is, we assume it's already been raised during type chedking). +let CheckInlineValueIsComplete (_v: Val) _res = + () +#else let CheckInlineValueIsComplete (v: Val) res = if v.ShouldInline && IsPartialExprVal res then errorR(Error(FSComp.SR.optValueMarkedInlineButIncomplete(v.DisplayName), v.Range)) //System.Diagnostics.Debug.Assert(false, sprintf "Break for incomplete inline value %s" v.DisplayName) +#endif let check (vref: ValRef) (res: ValInfo) = CheckInlineValueIsComplete vref.Deref res.ValExprInfo From 43c1bfd6cb7b9c7dc79ac49112f7c6f43cb88584 Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Fri, 26 Aug 2022 14:22:23 -0700 Subject: [PATCH 06/13] Fixed merge issues Fixed merge --- buildtools/AssemblyCheck/AssemblyCheck.fsproj | 2 + buildtools/buildtools.targets | 4 +- buildtools/fslex/fslex.fsproj | 4 ++ buildtools/fsyacc/fsyacc.fsproj | 4 ++ fcs/build.sh | 9 +-- fcs/fcs-test/Program.fs | 11 +-- fcs/fcs-test/fcs-test.fsproj | 9 +-- fcs/service_slim.fs | 72 +++++++++---------- src/Compiler/Driver/fsc.fs | 59 ++++++++++----- src/Compiler/Driver/fsc.fsi | 13 ++++ src/Compiler/FSharp.Compiler.Service.fsproj | 1 + src/Compiler/Service/FSharpCheckerResults.fsi | 6 +- src/Compiler/Service/service.fsi | 6 +- 13 files changed, 127 insertions(+), 73 deletions(-) diff --git a/buildtools/AssemblyCheck/AssemblyCheck.fsproj b/buildtools/AssemblyCheck/AssemblyCheck.fsproj index 78d24349889..bc7d7a52718 100644 --- a/buildtools/AssemblyCheck/AssemblyCheck.fsproj +++ b/buildtools/AssemblyCheck/AssemblyCheck.fsproj @@ -3,6 +3,8 @@ Exe $(FSharpNetCoreProductTargetFramework) + net8.0 + net6.0 true diff --git a/buildtools/buildtools.targets b/buildtools/buildtools.targets index 4cc7fe7a3a4..8332b53a237 100644 --- a/buildtools/buildtools.targets +++ b/buildtools/buildtools.targets @@ -20,7 +20,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\bin\fslex\Release\net5.0\fslex.dll + $(ArtifactsDir)\bin\fslex\Release\net6.0\fslex.dll @@ -44,7 +44,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\bin\fsyacc\Release\net5.0\fsyacc.dll + $(ArtifactsDir)\bin\fsyacc\Release\net6.0\fsyacc.dll diff --git a/buildtools/fslex/fslex.fsproj b/buildtools/fslex/fslex.fsproj index b450de1668d..98d2c0a301d 100644 --- a/buildtools/fslex/fslex.fsproj +++ b/buildtools/fslex/fslex.fsproj @@ -3,6 +3,10 @@ Exe $(FSharpNetCoreProductTargetFramework) + net8.0 + net7.0 + net6.0 + INTERNALIZED_FSLEXYACC_RUNTIME;$(DefineConstants) true LatestMajor $(NoWarn);64;1182;1204 diff --git a/buildtools/fsyacc/fsyacc.fsproj b/buildtools/fsyacc/fsyacc.fsproj index 5f97b762e03..374b89687f3 100644 --- a/buildtools/fsyacc/fsyacc.fsproj +++ b/buildtools/fsyacc/fsyacc.fsproj @@ -3,6 +3,10 @@ Exe $(FSharpNetCoreProductTargetFramework) + net8.0 + net7.0 + net6.0 + INTERNALIZED_FSLEXYACC_RUNTIME;$(DefineConstants) true LatestMajor $(NoWarn);64;1182;1204 diff --git a/fcs/build.sh b/fcs/build.sh index 98855758986..c571b3de4a1 100644 --- a/fcs/build.sh +++ b/fcs/build.sh @@ -1,5 +1,6 @@ -#!/usr/bin/env bash +#!/usr/bin/env bash -dotnet build -c Release src/buildtools/buildtools.proj -dotnet build -c Release src/fsharp/FSharp.Compiler.Service -#dotnet /usr/share/dotnet/sdk/5.0.402/MSBuild.dll /p:Configuration=Release /p:FscToolExe=fsc src/fsharp/FSharp.Compiler.Service/ +dotnet build -c Release buildtools +dotnet build -c Release src/Compiler +dotnet run -c Release --project fcs/fcs-test +echo "Binaries can be found here: /artifacts/bin/FSharp.Compiler.Service/Release/netstandard2.0/" \ No newline at end of file diff --git a/fcs/fcs-test/Program.fs b/fcs/fcs-test/Program.fs index 2cada0cbbd6..edb6522a71a 100644 --- a/fcs/fcs-test/Program.fs +++ b/fcs/fcs-test/Program.fs @@ -1,4 +1,4 @@ -open System.IO +open System.IO open FSharp.Compiler open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.SourceCodeServices @@ -76,11 +76,11 @@ let printAst title (projectResults: FSharpCheckProjectResults) = |> String.concat "\n" printfn "%s Typed AST:" title decls |> printfn "%s" - + [] let main argv = let projName = "Project.fsproj" - let fileName = "test_script.fsx" + let fileName = __SOURCE_DIRECTORY__ + "/test_script.fsx" let fileNames = [| fileName |] let source = File.ReadAllText (fileName, System.Text.Encoding.UTF8) @@ -116,11 +116,12 @@ let main argv = // Get declarations (autocomplete) for msg let partialName = { QualifyingIdents = []; PartialIdent = "msg"; EndColumn = 17; LastDotPos = None } let decls = typeCheckResults.GetDeclarationListInfo(Some parseResults, 6, inputLines.[5], partialName, (fun _ -> [])) - [ for item in decls.Items -> item.Name ] |> printfn "\n---> msg AutoComplete = %A" // should print string methods + [ for item in decls.Items -> item.NameInList ] |> printfn "\n---> msg AutoComplete = %A" // should print string methods // Get declarations (autocomplete) for canvas let partialName = { QualifyingIdents = []; PartialIdent = "canvas"; EndColumn = 10; LastDotPos = None } let decls = typeCheckResults.GetDeclarationListInfo(Some parseResults, 8, inputLines.[7], partialName, (fun _ -> [])) - [ for item in decls.Items -> item.Name ] |> printfn "\n---> canvas AutoComplete = %A" + [ for item in decls.Items -> item.NameInList ] |> printfn "\n---> canvas AutoComplete = %A" + printfn "Done." 0 diff --git a/fcs/fcs-test/fcs-test.fsproj b/fcs/fcs-test/fcs-test.fsproj index 72ab6dba64e..839638d2551 100644 --- a/fcs/fcs-test/fcs-test.fsproj +++ b/fcs/fcs-test/fcs-test.fsproj @@ -1,4 +1,4 @@ - + Exe @@ -12,15 +12,16 @@ - + + - + - + diff --git a/fcs/service_slim.fs b/fcs/service_slim.fs index 2d6c2bc86a0..7de2cc8dd78 100644 --- a/fcs/service_slim.fs +++ b/fcs/service_slim.fs @@ -10,12 +10,13 @@ open System.Threading open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras + open FSharp.Compiler open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.CodeAnalysis -open FSharp.Compiler.CheckExpressions +open FSharp.Compiler.CheckBasics open FSharp.Compiler.CheckDeclarations open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics @@ -24,8 +25,8 @@ open FSharp.Compiler.CompilerImports open FSharp.Compiler.CompilerOptions open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Driver -open FSharp.Compiler.ErrorLogger open FSharp.Compiler.NameResolution open FSharp.Compiler.ParseAndCheckInputs open FSharp.Compiler.ScriptClosure @@ -44,7 +45,7 @@ open FSharp.Compiler.BuildGraph // InteractiveChecker //------------------------------------------------------------------------- -type internal TcResult = TcEnv * TopAttribs * TypedImplFile option * ModuleOrNamespaceType +type internal TcResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType type internal TcErrors = FSharpDiagnostic[] type internal CompilerState = { @@ -109,19 +110,18 @@ module internal ParseAndCheck = let initializeCompilerState projectOptions reset = async { let tcConfig = let tcConfigB = - TcConfigBuilder.CreateNew(SimulatedMSBuildReferenceResolver.getResolver(), - includewin32manifest=false, - framework=false, - portablePDB=false, - defaultFSharpBinariesDir=FSharpCheckerResultsSettings.defaultFSharpBinariesDir, - reduceMemoryUsage=ReduceMemoryFlag.Yes, - implicitIncludeDir=Path.GetDirectoryName(projectOptions.ProjectFileName), - isInteractive=false, - isInvalidationSupported=true, - defaultCopyFSharpCore=CopyFSharpCoreFlag.No, - tryGetMetadataSnapshot=(fun _ -> None), - sdkDirOverride=None, - rangeForErrors=range0) + TcConfigBuilder.CreateNew( + SimulatedMSBuildReferenceResolver.getResolver(), + defaultFSharpBinariesDir = FSharpCheckerResultsSettings.defaultFSharpBinariesDir, + reduceMemoryUsage = ReduceMemoryFlag.Yes, + implicitIncludeDir = Path.GetDirectoryName(projectOptions.ProjectFileName), + isInteractive = false, + isInvalidationSupported = true, + defaultCopyFSharpCore = CopyFSharpCoreFlag.No, + tryGetMetadataSnapshot = (fun _ -> None), + sdkDirOverride = None, + rangeForErrors = range0 + ) let sourceFiles = projectOptions.SourceFiles |> Array.toList let argv = projectOptions.OtherOptions |> Array.toList let _sourceFiles = ApplyCommandLineArgs(tcConfigB, sourceFiles, argv) @@ -140,10 +140,9 @@ module internal ParseAndCheck = ccu.Deref.InvalidateEvent.Add(fun _ -> reset()) ) - let niceNameGen = NiceNameGenerator() let assemblyName = projectOptions.ProjectFileName |> Path.GetFileNameWithoutExtension let tcInitial, openDecls0 = GetInitialTcEnv (assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) - let tcInitialState = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, niceNameGen, tcInitial, openDecls0) + let tcInitialState = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, tcInitial, openDecls0) // parse cache, keyed on file name and source hash let parseCache = ConcurrentDictionary(HashIdentity.Structural) @@ -162,14 +161,14 @@ module internal ParseAndCheck = } let MakeProjectResults (projectFileName: string, parseResults: FSharpParseFileResults[], tcState: TcState, errors: FSharpDiagnostic[], - topAttrsOpt: TopAttribs option, tcImplFilesOpt: TypedImplFile list option, - compilerState) = + topAttrsOpt: TopAttribs option, tcImplFilesOpt: CheckedImplFile list option, compilerState) = let assemblyRef = mkSimpleAssemblyRef "stdin" let access = tcState.TcEnvFromImpls.AccessRights let symbolUses = Choice2Of2 TcSymbolUses.Empty let dependencyFiles = parseResults |> Seq.map (fun x -> x.DependencyFiles) |> Array.concat + let getAssemblyData () = None let details = (compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, tcState.CcuSig, symbolUses, topAttrsOpt, - assemblyRef, access, tcImplFilesOpt, dependencyFiles, compilerState.projectOptions) + getAssemblyData, assemblyRef, access, tcImplFilesOpt, dependencyFiles, compilerState.projectOptions) let keepAssemblyContents = true FSharpCheckProjectResults (projectFileName, Some compilerState.tcConfig, keepAssemblyContents, errors, Some details) @@ -199,20 +198,21 @@ module internal ParseAndCheck = let TypeCheckOneInputEntry (parseResults: FSharpParseFileResults, tcSink: TcResultsSink, tcState: TcState, moduleNamesDict: ModuleNamesDict, compilerState) = let input = parseResults.ParseTree - let capturingErrorLogger = CompilationErrorLogger("TypeCheckFile", compilerState.tcConfig.errorSeverityOptions) - let errorLogger = GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput(input), capturingErrorLogger) - use _errorScope = new CompilationGlobalsScope (errorLogger, BuildPhase.TypeCheck) + let diagnosticsOptions = compilerState.tcConfig.diagnosticsOptions + let capturingLogger = CompilationDiagnosticLogger("TypeCheckFile", diagnosticsOptions) + let diagnosticsLogger = GetDiagnosticsLoggerFilteringByScopedPragmas(false, input.ScopedPragmas, diagnosticsOptions, capturingLogger) + use _scope = new CompilationGlobalsScope (diagnosticsLogger, BuildPhase.TypeCheck) - let checkForErrors () = parseResults.ParseHadErrors || errorLogger.ErrorCount > 0 + let checkForErrors () = parseResults.ParseHadErrors || diagnosticsLogger.ErrorCount > 0 let prefixPathOpt = None let input, moduleNamesDict = input |> DeduplicateParsedInputModuleName moduleNamesDict let tcResult, tcState = - TypeCheckOneInput (checkForErrors, compilerState.tcConfig, compilerState.tcImports, compilerState.tcGlobals, prefixPathOpt, tcSink, tcState, input, false) - |> Cancellable.runWithoutCancellation + CheckOneInput (checkForErrors, compilerState.tcConfig, compilerState.tcImports, compilerState.tcGlobals, prefixPathOpt, tcSink, tcState, input, false) + |> Cancellable.runWithoutCancellation let fileName = parseResults.FileName - let tcErrors = DiagnosticHelpers.CreateDiagnostics (compilerState.tcConfig.errorSeverityOptions, false, fileName, (capturingErrorLogger.GetDiagnostics()), suggestNamesForErrors) + let tcErrors = DiagnosticHelpers.CreateDiagnostics (diagnosticsOptions, false, fileName, (capturingLogger.GetDiagnostics()), suggestNamesForErrors) (tcResult, tcErrors), (tcState, moduleNamesDict) let CheckFile (projectFileName: string, parseResults: FSharpParseFileResults, tcState: TcState, moduleNamesDict: ModuleNamesDict, compilerState) = @@ -239,7 +239,7 @@ module internal ParseAndCheck = let checkCacheKey = parseRes.FileName let typeCheckOneInput _fileName = - TypeCheckOneInputEntry (parseRes, TcResultsSink.NoSink, tcState, moduleNamesDict, compilerState) + TypeCheckOneInputEntry (parseRes, TcResultsSink.NoSink, tcState, moduleNamesDict, compilerState) let (result, errors), (tcState, moduleNamesDict) = compilerState.checkCache.GetOrAdd(checkCacheKey, typeCheckOneInput) @@ -257,9 +257,9 @@ module internal ParseAndCheck = let tcResults, tcErrors = Array.unzip results let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _ccuSigsForFiles), tcState = - TypeCheckMultipleInputsFinish(tcResults |> Array.toList, tcState) + CheckMultipleInputsFinish(tcResults |> Array.toList, tcState) - let tcState, declaredImpls, ccuContents = TypeCheckClosedInputSetFinish (implFiles, tcState) + let tcState, declaredImpls, ccuContents = CheckClosedInputSetFinish (implFiles, tcState) tcState.Ccu.Deref.Contents <- ccuContents tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile, moduleNamesDict, tcErrors @@ -304,11 +304,11 @@ type InteractiveChecker internal (compilerStateCache) = TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState, None) let ctok = CompilationThreadToken() - let errors, errorLogger, _loggerProvider = CompileHelpers.mkCompilationErrorHandlers() + let errors, diagnosticsLogger, _loggerProvider = CompileHelpers.mkCompilationDiagnosticsHandlers() let exitCode = - CompileHelpers.tryCompile errorLogger (fun exiter -> - compileOfTypedAst (ctok, compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, - tcImplFiles, topAttrs, compilerState.tcConfig, outFile, errorLogger, exiter)) + CompileHelpers.tryCompile diagnosticsLogger (fun exiter -> + CompileFromTypedAst (ctok, compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, + tcImplFiles, topAttrs, compilerState.tcConfig, outFile, diagnosticsLogger, exiter)) return errors.ToArray(), exitCode } @@ -340,7 +340,7 @@ type InteractiveChecker internal (compilerStateCache) = fileNames |> Array.map parseFile // type check files - let (tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, _moduleNamesDict, tcErrors) = // measureTime <| fun _ -> + let (tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, _moduleNamesDict, tcErrors) = TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState, subscriber) // make project results diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index e443595f4ff..c9407a98174 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -1264,19 +1264,46 @@ let CompileFromCommandLineArguments |> main5 |> main6 dynamicAssemblyCreator -let compileOfTypedAst - (ctok, tcGlobals, tcImports: TcImports, generatedCcu: CcuThunk, typedImplFiles, - topAttrs, tcConfig: TcConfig, outfile, errorLogger, exiter: Exiter) = - - let tcImportsCapture = None - let dynamicAssemblyCreator = None - let assemblyName = Path.GetFileNameWithoutExtension(outfile) - // Doubling here tcImports as frameworkTcImports, seems to work... - let frameworkTcImports = tcImports - - Args (ctok, tcGlobals, tcImports, frameworkTcImports, generatedCcu, typedImplFiles, topAttrs, tcConfig, outfile, None, assemblyName, errorLogger, exiter) - |> main2 - |> main3 - |> main4 (tcImportsCapture, dynamicAssemblyCreator) - |> main5 - |> main6 dynamicAssemblyCreator +let CompileFromTypedAst + ( + ctok, + tcGlobals, + tcImports: TcImports, + generatedCcu: CcuThunk, + typedImplFiles, + topAttrs, + tcConfig: TcConfig, + outfile, + diagnosticsLogger, + exiter: Exiter + ) = + + let tcImportsCapture = None + let dynamicAssemblyCreator = None + let assemblyName = Path.GetFileNameWithoutExtension(outfile) + // Doubling here tcImports as frameworkTcImports, seems to work... + let frameworkTcImports = tcImports + let pdbfile = None + let ilSourceDocs = [] + + Args ( + ctok, + tcGlobals, + tcImports, + frameworkTcImports, + generatedCcu, + typedImplFiles, + topAttrs, + tcConfig, + outfile, + pdbfile, + assemblyName, + diagnosticsLogger, + exiter, + ilSourceDocs + ) + |> main2 + |> main3 + |> main4 (tcImportsCapture, dynamicAssemblyCreator) + |> main5 + |> main6 dynamicAssemblyCreator diff --git a/src/Compiler/Driver/fsc.fsi b/src/Compiler/Driver/fsc.fsi index 8731b5fae0c..ab4af0b6e8b 100644 --- a/src/Compiler/Driver/fsc.fsi +++ b/src/Compiler/Driver/fsc.fsi @@ -58,3 +58,16 @@ val CompileFromCommandLineArguments: /// Read the parallelReferenceResolution flag from environment variables val internal getParallelReferenceResolutionFromEnvironment: unit -> ParallelReferenceResolution option + +val CompileFromTypedAst: + ctok: CompilationThreadToken * + tcGlobals: TcGlobals * + tcImports: TcImports * + generatedCcu: TypedTree.CcuThunk * + typedImplFiles: TypedTree.CheckedImplFile list * + topAttrs: CheckDeclarations.TopAttribs * + tcConfig: TcConfig * + outfile: string * + diagnosticsLogger: DiagnosticsLogger * + exiter: Exiter + -> unit diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index 7104a85b578..e3b92cef3ce 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -14,6 +14,7 @@ $(OtherFlags) --warnaserror-:1182 FSharp.Compiler.Service true + $(DefineConstants);FABLE_CLI $(DefineConstants);COMPILER true @@ -44,7 +44,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\bin\fsyacc\Release\net6.0\fsyacc.dll + $(ArtifactsDir)\bin\fsyacc\Release\net7.0\fsyacc.dll diff --git a/buildtools/fslex/fslex.fsproj b/buildtools/fslex/fslex.fsproj index 98d2c0a301d..26f6d26ee49 100644 --- a/buildtools/fslex/fslex.fsproj +++ b/buildtools/fslex/fslex.fsproj @@ -5,7 +5,6 @@ $(FSharpNetCoreProductTargetFramework) net8.0 net7.0 - net6.0 INTERNALIZED_FSLEXYACC_RUNTIME;$(DefineConstants) true LatestMajor diff --git a/buildtools/fsyacc/fsyacc.fsproj b/buildtools/fsyacc/fsyacc.fsproj index 374b89687f3..d538e5bd163 100644 --- a/buildtools/fsyacc/fsyacc.fsproj +++ b/buildtools/fsyacc/fsyacc.fsproj @@ -5,7 +5,6 @@ $(FSharpNetCoreProductTargetFramework) net8.0 net7.0 - net6.0 INTERNALIZED_FSLEXYACC_RUNTIME;$(DefineConstants) true LatestMajor diff --git a/fcs/fcs-test/Program.fs b/fcs/fcs-test/Program.fs index edb6522a71a..fdefd83d449 100644 --- a/fcs/fcs-test/Program.fs +++ b/fcs/fcs-test/Program.fs @@ -1,41 +1,92 @@ open System.IO +open System.Text.RegularExpressions open FSharp.Compiler open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.SourceCodeServices open FSharp.Compiler.EditorServices - -let getProjectOptions (folder: string) (projectFile: string) = - let runProcess (workingDir: string) (exePath: string) (args: string) = - let psi = System.Diagnostics.ProcessStartInfo() - psi.FileName <- exePath - psi.WorkingDirectory <- workingDir - psi.RedirectStandardOutput <- false - psi.RedirectStandardError <- false - psi.Arguments <- args - psi.CreateNoWindow <- true - psi.UseShellExecute <- false - - use p = new System.Diagnostics.Process() - p.StartInfo <- psi - p.Start() |> ignore - p.WaitForExit() - - let exitCode = p.ExitCode - exitCode, () - - let runCmd exePath args = runProcess folder exePath (args |> String.concat " ") - let msbuildExec = Dotnet.ProjInfo.Inspect.dotnetMsbuild runCmd - let result = Dotnet.ProjInfo.Inspect.getProjectInfo ignore msbuildExec Dotnet.ProjInfo.Inspect.getFscArgs projectFile - match result with - | Ok (Dotnet.ProjInfo.Inspect.GetResult.FscArgs x) -> x - | _ -> [] +open Buildalyzer + +let getProjectOptionsFromProjectFile (isMain: bool) (projFile: string) = + + let tryGetResult (isMain: bool) (manager: AnalyzerManager) (maybeCsprojFile: string) = + + let analyzer = manager.GetProject(maybeCsprojFile) + let env = analyzer.EnvironmentFactory.GetBuildEnvironment(Environment.EnvironmentOptions(DesignTime=true,Restore=false)) + // If System.the project targets multiple frameworks, multiple results will be returned + // For now we just take the first one with non-empty command + let results = analyzer.Build(env) + results + |> Seq.tryFind (fun r -> System.String.IsNullOrEmpty(r.Command) |> not) + + let manager = + let log = new StringWriter() + let options = AnalyzerManagerOptions(LogWriter = log) + let m = AnalyzerManager(options) + m + + // Because Buildalyzer works better with .csproj, we first "dress up" the project as if it were a C# one + // and try to adapt the results. If it doesn't work, we try again to analyze the .fsproj directly + let csprojResult = + let csprojFile = projFile.Replace(".fsproj", ".csproj") + if File.Exists(csprojFile) then + None + else + try + File.Copy(projFile, csprojFile) + tryGetResult isMain manager csprojFile + |> Option.map (fun (r: IAnalyzerResult) -> + // Careful, options for .csproj start with / but so do root paths in unix + let reg = Regex(@"^\/[^\/]+?(:?:|$)") + let comArgs = + r.CompilerArguments + |> Array.map (fun line -> + if reg.IsMatch(line) then + if line.StartsWith("/reference") then "-r" + line.Substring(10) + else "--" + line.Substring(1) + else line) + let comArgs = + match r.Properties.TryGetValue("OtherFlags") with + | false, _ -> comArgs + | true, otherFlags -> + let otherFlags = otherFlags.Split(' ', System.StringSplitOptions.RemoveEmptyEntries) + Array.append otherFlags comArgs + comArgs, r) + finally + File.Delete(csprojFile) + + let compilerArgs, result = + csprojResult + |> Option.orElseWith (fun () -> + tryGetResult isMain manager projFile + |> Option.map (fun r -> + // result.CompilerArguments doesn't seem to work well in Linux + let comArgs = Regex.Split(r.Command, @"\r?\n") + comArgs, r)) + |> function + | Some result -> result + // TODO: Get Buildalyzer errors from the log + | None -> failwith $"Cannot parse {projFile}" + + let projDir = Path.GetDirectoryName(projFile) + let projOpts = + compilerArgs + |> Array.skipWhile (fun line -> not(line.StartsWith("-"))) + |> Array.map (fun f -> + if f.EndsWith(".fs") || f.EndsWith(".fsi") then + if Path.IsPathRooted f then f else Path.Combine(projDir, f) + else f) + projOpts, + Seq.toArray result.ProjectReferences, + result.Properties, + result.TargetFramework let mkStandardProjectReferences () = - let projFile = "fcs-test.fsproj" + let fileName = "fcs-test.fsproj" let projDir = __SOURCE_DIRECTORY__ - getProjectOptions projDir projFile - |> List.filter (fun s -> s.StartsWith("-r:")) - |> List.map (fun s -> s.Replace("-r:", "")) + let projFile = Path.Combine(projDir, fileName) + let (args, _, _, _) = getProjectOptionsFromProjectFile true projFile + args + |> Array.filter (fun s -> s.StartsWith("-r:")) let mkProjectCommandLineArgsForScript (dllName, fileNames) = [| yield "--simpleresolution" @@ -53,7 +104,7 @@ let mkProjectCommandLineArgsForScript (dllName, fileNames) = yield x let references = mkStandardProjectReferences () for r in references do - yield "-r:" + r + yield r |] let getProjectOptionsFromCommandLineArgs(projName, argv): FSharpProjectOptions = diff --git a/fcs/fcs-test/fcs-test.fsproj b/fcs/fcs-test/fcs-test.fsproj index 839638d2551..3a8c1940791 100644 --- a/fcs/fcs-test/fcs-test.fsproj +++ b/fcs/fcs-test/fcs-test.fsproj @@ -2,12 +2,12 @@ Exe - net6.0 + net7.0 true - + @@ -19,9 +19,9 @@ - - - + + + diff --git a/fcs/service_slim.fs b/fcs/service_slim.fs index 7de2cc8dd78..f7c5b9b2343 100644 --- a/fcs/service_slim.fs +++ b/fcs/service_slim.fs @@ -90,6 +90,7 @@ module internal ParseAndCheck = let userOpName = "Unknown" let suggestNamesForErrors = true + let captureIdentifiersWhenParsing = false let measureTime (f: unit -> 'a) = let sw = Diagnostics.Stopwatch.StartNew() @@ -192,7 +193,7 @@ module internal ParseAndCheck = compilerState.parseCache.GetOrAdd(parseCacheKey, fun _ -> ClearStaleCache(fileName, parsingOptions, compilerState) let sourceText = SourceText.ofString source.Value - let parseErrors, parseTreeOpt, anyErrors = ParseAndCheckFile.parseFile (sourceText, fileName, parsingOptions, userOpName, suggestNamesForErrors) + let parseErrors, parseTreeOpt, anyErrors = ParseAndCheckFile.parseFile (sourceText, fileName, parsingOptions, userOpName, suggestNamesForErrors, captureIdentifiersWhenParsing) let dependencyFiles = [||] // interactions have no dependencies FSharpParseFileResults (parseErrors, parseTreeOpt, anyErrors, dependencyFiles) ) @@ -208,7 +209,7 @@ module internal ParseAndCheck = let input, moduleNamesDict = input |> DeduplicateParsedInputModuleName moduleNamesDict let tcResult, tcState = - CheckOneInput (checkForErrors, compilerState.tcConfig, compilerState.tcImports, compilerState.tcGlobals, prefixPathOpt, tcSink, tcState, input, false) + CheckOneInput (checkForErrors, compilerState.tcConfig, compilerState.tcImports, compilerState.tcGlobals, prefixPathOpt, tcSink, tcState, input) |> Cancellable.runWithoutCancellation let fileName = parseResults.FileName From f16fd5f2fa702c46f0042a2599a1894a56f52703 Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Sun, 15 Oct 2023 14:27:59 -0700 Subject: [PATCH 09/13] Fixed merge --- .vscode/launch.json | 2 +- buildtools/AssemblyCheck/AssemblyCheck.fsproj | 2 -- buildtools/buildtools.targets | 4 ++-- buildtools/fslex/fslex.fsproj | 2 -- buildtools/fsyacc/fsyacc.fsproj | 2 -- fcs/fcs-test/fcs-test.fsproj | 8 +++---- fcs/service_slim.fs | 22 +++++++++++++------ src/Compiler/Service/service.fsi | 2 +- 8 files changed, 23 insertions(+), 21 deletions(-) diff --git a/.vscode/launch.json b/.vscode/launch.json index 3af8de8dc67..e424c366f12 100644 --- a/.vscode/launch.json +++ b/.vscode/launch.json @@ -97,7 +97,7 @@ "name": "FCS Test", "type": "coreclr", "request": "launch", - "program": "${workspaceFolder}/artifacts/bin/fcs-test/Debug/net7.0/fcs-test.dll", + "program": "${workspaceFolder}/artifacts/bin/fcs-test/Debug/net8.0/fcs-test.dll", "args": [], "cwd": "${workspaceFolder}/fcs/fcs-test", "console": "internalConsole", diff --git a/buildtools/AssemblyCheck/AssemblyCheck.fsproj b/buildtools/AssemblyCheck/AssemblyCheck.fsproj index 000c7044114..9c5a5b11e14 100644 --- a/buildtools/AssemblyCheck/AssemblyCheck.fsproj +++ b/buildtools/AssemblyCheck/AssemblyCheck.fsproj @@ -4,8 +4,6 @@ Exe $(FSharpNetCoreProductTargetFramework) net8.0 - net6.0 - net7.0 true diff --git a/buildtools/buildtools.targets b/buildtools/buildtools.targets index 3b2fa489c66..b4160b714f2 100644 --- a/buildtools/buildtools.targets +++ b/buildtools/buildtools.targets @@ -20,7 +20,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\bin\fslex\Release\net7.0\fslex.dll + $(ArtifactsDir)\bin\fslex\Release\net8.0\fslex.dll @@ -44,7 +44,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\bin\fsyacc\Release\net7.0\fsyacc.dll + $(ArtifactsDir)\bin\fsyacc\Release\net8.0\fsyacc.dll diff --git a/buildtools/fslex/fslex.fsproj b/buildtools/fslex/fslex.fsproj index 26f6d26ee49..b2b744c4a92 100644 --- a/buildtools/fslex/fslex.fsproj +++ b/buildtools/fslex/fslex.fsproj @@ -4,8 +4,6 @@ Exe $(FSharpNetCoreProductTargetFramework) net8.0 - net7.0 - INTERNALIZED_FSLEXYACC_RUNTIME;$(DefineConstants) true LatestMajor $(NoWarn);64;1182;1204 diff --git a/buildtools/fsyacc/fsyacc.fsproj b/buildtools/fsyacc/fsyacc.fsproj index d538e5bd163..cf4e599e25c 100644 --- a/buildtools/fsyacc/fsyacc.fsproj +++ b/buildtools/fsyacc/fsyacc.fsproj @@ -4,8 +4,6 @@ Exe $(FSharpNetCoreProductTargetFramework) net8.0 - net7.0 - INTERNALIZED_FSLEXYACC_RUNTIME;$(DefineConstants) true LatestMajor $(NoWarn);64;1182;1204 diff --git a/fcs/fcs-test/fcs-test.fsproj b/fcs/fcs-test/fcs-test.fsproj index 3a8c1940791..fd951e954ea 100644 --- a/fcs/fcs-test/fcs-test.fsproj +++ b/fcs/fcs-test/fcs-test.fsproj @@ -2,7 +2,7 @@ Exe - net7.0 + net8.0 true @@ -19,9 +19,9 @@ - - - + + + diff --git a/fcs/service_slim.fs b/fcs/service_slim.fs index f7c5b9b2343..7cccc9f4168 100644 --- a/fcs/service_slim.fs +++ b/fcs/service_slim.fs @@ -188,12 +188,14 @@ module internal ParseAndCheck = // restore all cached typecheck entries above file cachedAbove |> Array.iter (fun (key, value) -> compilerState.checkCache.TryAdd(key, value) |> ignore) - let ParseFile (fileName: string, sourceHash: int, source: Lazy, parsingOptions: FSharpParsingOptions, compilerState) = + let ParseFile (fileName: string, sourceHash: int, source: Lazy, parsingOptions: FSharpParsingOptions, compilerState, ct) = let parseCacheKey = fileName, sourceHash compilerState.parseCache.GetOrAdd(parseCacheKey, fun _ -> ClearStaleCache(fileName, parsingOptions, compilerState) let sourceText = SourceText.ofString source.Value - let parseErrors, parseTreeOpt, anyErrors = ParseAndCheckFile.parseFile (sourceText, fileName, parsingOptions, userOpName, suggestNamesForErrors, captureIdentifiersWhenParsing) + let flatErrors = compilerState.tcConfig.flatErrors + let parseErrors, parseTreeOpt, anyErrors = + ParseAndCheckFile.parseFile (sourceText, fileName, parsingOptions, userOpName, suggestNamesForErrors, flatErrors, captureIdentifiersWhenParsing, ct) let dependencyFiles = [||] // interactions have no dependencies FSharpParseFileResults (parseErrors, parseTreeOpt, anyErrors, dependencyFiles) ) @@ -213,7 +215,9 @@ module internal ParseAndCheck = |> Cancellable.runWithoutCancellation let fileName = parseResults.FileName - let tcErrors = DiagnosticHelpers.CreateDiagnostics (diagnosticsOptions, false, fileName, (capturingLogger.GetDiagnostics()), suggestNamesForErrors) + let flatErrors = compilerState.tcConfig.flatErrors + let parseDiagnostics = capturingLogger.GetDiagnostics() + let tcErrors = DiagnosticHelpers.CreateDiagnostics (diagnosticsOptions, false, fileName, parseDiagnostics, suggestNamesForErrors, flatErrors, None) (tcResult, tcErrors), (tcState, moduleNamesDict) let CheckFile (projectFileName: string, parseResults: FSharpParseFileResults, tcState: TcState, moduleNamesDict: ModuleNamesDict, compilerState) = @@ -295,17 +299,19 @@ type InteractiveChecker internal (compilerStateCache) = /// Compile project to file. If project has already been type checked, /// check results will be taken from the cache. member _.Compile(fileNames: string[], sourceReader: string -> int * Lazy, outFile: string) = async { + let! ct = Async.CancellationToken let! compilerState = compilerStateCache.Get() let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) let parseResults = fileNames |> Array.map (fun fileName -> let sourceHash, source = sourceReader fileName - ParseFile(fileName, sourceHash, source, parsingOptions, compilerState)) + ParseFile(fileName, sourceHash, source, parsingOptions, compilerState, ct)) let (tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, _moduleNamesDict, _tcErrors) = TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState, None) let ctok = CompilationThreadToken() - let errors, diagnosticsLogger, _loggerProvider = CompileHelpers.mkCompilationDiagnosticsHandlers() + let flatErrors = compilerState.tcConfig.flatErrors + let errors, diagnosticsLogger, _loggerProvider = CompileHelpers.mkCompilationDiagnosticsHandlers(flatErrors) let exitCode = CompileHelpers.tryCompile diagnosticsLogger (fun exiter -> CompileFromTypedAst (ctok, compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, @@ -319,6 +325,7 @@ type InteractiveChecker internal (compilerStateCache) = /// Already parsed files will be cached so subsequent compilations will be faster. member _.ParseAndCheckProject (projectFileName: string, fileNames: string[], sourceReader: string -> int * Lazy, ?lastFile: string, ?subscriber: FSharpImplementationFileContents -> unit) = async { + let! ct = Async.CancellationToken let! compilerState = compilerStateCache.Get() // parse files let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) @@ -332,7 +339,7 @@ type InteractiveChecker internal (compilerStateCache) = let parseFile fileName = let sourceHash, source = sourceReader fileName - ParseFile(fileName, sourceHash, source, parsingOptions, compilerState) + ParseFile(fileName, sourceHash, source, parsingOptions, compilerState, ct) // Don't parallelize if we have cached files, as it would create issues with invalidation if compilerState.parseCache.Count = 0 then @@ -358,6 +365,7 @@ type InteractiveChecker internal (compilerStateCache) = /// up to and including the file requested. Returns parse and typecheck results containing /// name resolutions and symbol uses for the file requested only, so intellisense etc. works. member _.ParseAndCheckFileInProject (projectFileName: string, fileNames: string[], sourceReader: string -> int * Lazy, fileName: string) = async { + let! ct = Async.CancellationToken let! compilerState = compilerStateCache.Get() // get files before file @@ -368,7 +376,7 @@ type InteractiveChecker internal (compilerStateCache) = let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) let parseFile fileName = let sourceHash, source = sourceReader fileName - ParseFile (fileName, sourceHash, source, parsingOptions, compilerState) + ParseFile (fileName, sourceHash, source, parsingOptions, compilerState, ct) let parseResults = fileNamesBeforeFile |> Array.map parseFile // type check files before file diff --git a/src/Compiler/Service/service.fsi b/src/Compiler/Service/service.fsi index de53fec08dc..e98f74a6029 100644 --- a/src/Compiler/Service/service.fsi +++ b/src/Compiler/Service/service.fsi @@ -22,7 +22,7 @@ open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Driver module internal CompileHelpers = - val mkCompilationDiagnosticsHandlers: unit -> ResizeArray * DiagnosticsLogger * IDiagnosticsLoggerProvider + val mkCompilationDiagnosticsHandlers: bool -> ResizeArray * DiagnosticsLogger * IDiagnosticsLoggerProvider val tryCompile: DiagnosticsLogger -> (StopProcessingExiter -> unit) -> int /// Used to parse and check F# source code. From 8df5055d2ce3d1a73c9cff68230d8aac6ce987c3 Mon Sep 17 00:00:00 2001 From: Florian Verdonck Date: Wed, 25 Oct 2023 11:47:21 +0200 Subject: [PATCH 10/13] Add GetDependentFiles to slim service. (#14) --- fcs/service_slim.fs | 48 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) diff --git a/fcs/service_slim.fs b/fcs/service_slim.fs index 7cccc9f4168..dd15de27d58 100644 --- a/fcs/service_slim.fs +++ b/fcs/service_slim.fs @@ -40,6 +40,7 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.BuildGraph +open FSharp.Compiler.GraphChecking //------------------------------------------------------------------------- // InteractiveChecker @@ -403,3 +404,50 @@ type InteractiveChecker internal (compilerStateCache) = return (parseFileResults, checkFileResults, projectResults) } + + /// Find the dependent files of the current file based on the untyped syntax tree + member _.GetDependentFiles(currentFileName: string, fileNames: string[], sourceReader: string -> int * Lazy) = async { + // parse files + let! ct = Async.CancellationToken + let! compilerState = compilerStateCache.Get() + // parse files + let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) + let parseFile fileName = + let sourceHash, source = sourceReader fileName + ParseFile (fileName, sourceHash, source, parsingOptions, compilerState, ct) + + // TODO: not sure if parse cache issues still applies + let parseResults = fileNames |> Array.Parallel.map parseFile + let sourceFiles: FileInProject array = + parseResults + |> Array.mapi (fun idx (parseResults: FSharpParseFileResults) -> + let input = parseResults.ParseTree + { + Idx = idx + FileName = input.FileName + ParsedInput = input + }) + + let currentFileIdx = Array.IndexOf(fileNames, currentFileName) + + let filePairs = FilePairMap(sourceFiles) + let graph, _trie = DependencyResolution.mkGraph filePairs sourceFiles + + let dependentFiles = + graph.Keys + |> Seq.choose (fun fileIndex -> + let isDependency = + // Only files that came after the current file are relevant + fileIndex > currentFileIdx + && + // The current file is listed as a dependency + Array.contains currentFileIdx graph.[fileIndex] + if not isDependency then + None + else + Some(Array.item fileIndex fileNames) + ) + |> Seq.toArray + + return dependentFiles + } \ No newline at end of file From d2207db8f145e862df666df8887ab402fe5013fa Mon Sep 17 00:00:00 2001 From: Florian Verdonck Date: Wed, 1 Nov 2023 18:26:55 +0100 Subject: [PATCH 11/13] Find all transitive dependent files. (#15) --- fcs/service_slim.fs | 40 ++++++++++++++++++++++------------------ 1 file changed, 22 insertions(+), 18 deletions(-) diff --git a/fcs/service_slim.fs b/fcs/service_slim.fs index dd15de27d58..1ea3ecab5df 100644 --- a/fcs/service_slim.fs +++ b/fcs/service_slim.fs @@ -405,7 +405,7 @@ type InteractiveChecker internal (compilerStateCache) = return (parseFileResults, checkFileResults, projectResults) } - /// Find the dependent files of the current file based on the untyped syntax tree + /// Find the transitive dependent files of the current file based on the untyped syntax tree. member _.GetDependentFiles(currentFileName: string, fileNames: string[], sourceReader: string -> int * Lazy) = async { // parse files let! ct = Async.CancellationToken @@ -431,23 +431,27 @@ type InteractiveChecker internal (compilerStateCache) = let currentFileIdx = Array.IndexOf(fileNames, currentFileName) let filePairs = FilePairMap(sourceFiles) - let graph, _trie = DependencyResolution.mkGraph filePairs sourceFiles - - let dependentFiles = - graph.Keys - |> Seq.choose (fun fileIndex -> - let isDependency = - // Only files that came after the current file are relevant - fileIndex > currentFileIdx - && - // The current file is listed as a dependency - Array.contains currentFileIdx graph.[fileIndex] - if not isDependency then - None + let graph, _trie = DependencyResolution.mkGraph filePairs sourceFiles + let findTransitiveDependencies (startNode : FileIndex) : FileIndex array = + let rec dfs (node : FileIndex) (visited : Set) (acc : FileIndex array) : FileIndex array = + if (Set.contains node visited) then + acc else - Some(Array.item fileIndex fileNames) - ) - |> Seq.toArray + let neighbors = graph.[node] + let visited' = Set.add node visited + + let acc' = + Array.fold (fun innerAcc neighbor -> dfs neighbor visited' innerAcc) acc neighbors + + [| yield! acc' ; yield node |] + + dfs startNode Set.empty Array.empty + |> Array.sort + + let dependentFiles = + findTransitiveDependencies currentFileIdx + |> Array.sort + |> Array.map (fun idx -> Array.item idx fileNames) return dependentFiles - } \ No newline at end of file + } From ecf3eeb1e01db51adc04ad3450b6a59a5b5e617e Mon Sep 17 00:00:00 2001 From: Florian Verdonck Date: Wed, 1 Nov 2023 21:02:12 +0100 Subject: [PATCH 12/13] Correct algorithm to find dependent files. (#16) --- fcs/service_slim.fs | 29 ++++++++++++++++++++--------- 1 file changed, 20 insertions(+), 9 deletions(-) diff --git a/fcs/service_slim.fs b/fcs/service_slim.fs index 1ea3ecab5df..53a4a32ba9a 100644 --- a/fcs/service_slim.fs +++ b/fcs/service_slim.fs @@ -432,24 +432,35 @@ type InteractiveChecker internal (compilerStateCache) = let filePairs = FilePairMap(sourceFiles) let graph, _trie = DependencyResolution.mkGraph filePairs sourceFiles - let findTransitiveDependencies (startNode : FileIndex) : FileIndex array = + let findTransitiveDependentFiles (startNode : FileIndex) : FileIndex array = let rec dfs (node : FileIndex) (visited : Set) (acc : FileIndex array) : FileIndex array = if (Set.contains node visited) then acc else - let neighbors = graph.[node] - let visited' = Set.add node visited - - let acc' = - Array.fold (fun innerAcc neighbor -> dfs neighbor visited' innerAcc) acc neighbors - - [| yield! acc' ; yield node |] + let newVisited = Set.add node visited + + let consumers = + // Last node in the project cannot have + if node = graph.Count - 1 then + acc + else + // Look if the next nodes depend on the current node + [| (node + 1) .. (graph.Count - 1) |] + |> Array.fold + (fun innerAcc nextIdx -> + if not (Array.contains node graph.[nextIdx]) then + innerAcc + else + dfs nextIdx newVisited innerAcc) + acc + + [| yield node; yield! consumers |] dfs startNode Set.empty Array.empty |> Array.sort let dependentFiles = - findTransitiveDependencies currentFileIdx + findTransitiveDependentFiles currentFileIdx |> Array.sort |> Array.map (fun idx -> Array.item idx fileNames) From a5434777843b080c440c71d6f311a1824cd79790 Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Fri, 15 Nov 2024 17:01:26 -0800 Subject: [PATCH 13/13] Fixed merge issues --- buildtools/AssemblyCheck/AssemblyCheck.fsproj | 1 - buildtools/buildtools.targets | 4 ++-- buildtools/fslex/fslex.fsproj | 1 - buildtools/fsyacc/fsyacc.fsproj | 1 - fcs/build.sh | 3 ++- fcs/fcs-test/fcs-test.fsproj | 10 +++++----- fcs/service_slim.fs | 11 +++++------ src/Compiler/Checking/NicePrint.fs | 1 + src/Compiler/Driver/fsc.fs | 4 ++-- src/Compiler/Service/service.fsi | 2 +- 10 files changed, 18 insertions(+), 20 deletions(-) diff --git a/buildtools/AssemblyCheck/AssemblyCheck.fsproj b/buildtools/AssemblyCheck/AssemblyCheck.fsproj index 9c5a5b11e14..78d24349889 100644 --- a/buildtools/AssemblyCheck/AssemblyCheck.fsproj +++ b/buildtools/AssemblyCheck/AssemblyCheck.fsproj @@ -3,7 +3,6 @@ Exe $(FSharpNetCoreProductTargetFramework) - net8.0 true diff --git a/buildtools/buildtools.targets b/buildtools/buildtools.targets index b4160b714f2..ed0259f01c7 100644 --- a/buildtools/buildtools.targets +++ b/buildtools/buildtools.targets @@ -20,7 +20,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\bin\fslex\Release\net8.0\fslex.dll + $(ArtifactsDir)\bin\fslex\Release\net9.0\linux-x64\fslex.dll @@ -44,7 +44,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\bin\fsyacc\Release\net8.0\fsyacc.dll + $(ArtifactsDir)\bin\fsyacc\Release\net9.0\linux-x64\fsyacc.dll diff --git a/buildtools/fslex/fslex.fsproj b/buildtools/fslex/fslex.fsproj index b2b744c4a92..b450de1668d 100644 --- a/buildtools/fslex/fslex.fsproj +++ b/buildtools/fslex/fslex.fsproj @@ -3,7 +3,6 @@ Exe $(FSharpNetCoreProductTargetFramework) - net8.0 true LatestMajor $(NoWarn);64;1182;1204 diff --git a/buildtools/fsyacc/fsyacc.fsproj b/buildtools/fsyacc/fsyacc.fsproj index cf4e599e25c..5f97b762e03 100644 --- a/buildtools/fsyacc/fsyacc.fsproj +++ b/buildtools/fsyacc/fsyacc.fsproj @@ -3,7 +3,6 @@ Exe $(FSharpNetCoreProductTargetFramework) - net8.0 true LatestMajor $(NoWarn);64;1182;1204 diff --git a/fcs/build.sh b/fcs/build.sh index c571b3de4a1..99848aa8ffa 100644 --- a/fcs/build.sh +++ b/fcs/build.sh @@ -1,6 +1,7 @@ #!/usr/bin/env bash -dotnet build -c Release buildtools +dotnet build -c Release buildtools/fslex +dotnet build -c Release buildtools/fsyacc dotnet build -c Release src/Compiler dotnet run -c Release --project fcs/fcs-test echo "Binaries can be found here: /artifacts/bin/FSharp.Compiler.Service/Release/netstandard2.0/" \ No newline at end of file diff --git a/fcs/fcs-test/fcs-test.fsproj b/fcs/fcs-test/fcs-test.fsproj index fd951e954ea..d401fb31e84 100644 --- a/fcs/fcs-test/fcs-test.fsproj +++ b/fcs/fcs-test/fcs-test.fsproj @@ -2,7 +2,7 @@ Exe - net8.0 + net9.0 true @@ -19,9 +19,9 @@ - - - - + + + + diff --git a/fcs/service_slim.fs b/fcs/service_slim.fs index 53a4a32ba9a..d80132171a8 100644 --- a/fcs/service_slim.fs +++ b/fcs/service_slim.fs @@ -116,7 +116,7 @@ module internal ParseAndCheck = SimulatedMSBuildReferenceResolver.getResolver(), defaultFSharpBinariesDir = FSharpCheckerResultsSettings.defaultFSharpBinariesDir, reduceMemoryUsage = ReduceMemoryFlag.Yes, - implicitIncludeDir = Path.GetDirectoryName(projectOptions.ProjectFileName), + implicitIncludeDir = !! Path.GetDirectoryName(projectOptions.ProjectFileName), isInteractive = false, isInvalidationSupported = true, defaultCopyFSharpCore = CopyFSharpCoreFlag.No, @@ -134,7 +134,6 @@ module internal ParseAndCheck = let dependencyProvider = new DependencyProvider() let! tcGlobals, tcImports = TcImports.BuildTcImports (tcConfigP, dependencyProvider) - |> Async.AwaitNodeCode // Handle type provider invalidation by resetting compiler state tcImports.GetCcusExcludingBase() @@ -142,7 +141,7 @@ module internal ParseAndCheck = ccu.Deref.InvalidateEvent.Add(fun _ -> reset()) ) - let assemblyName = projectOptions.ProjectFileName |> Path.GetFileNameWithoutExtension + let assemblyName = !! Path.GetFileNameWithoutExtension(projectOptions.ProjectFileName) let tcInitial, openDecls0 = GetInitialTcEnv (assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) let tcInitialState = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, tcInitial, openDecls0) @@ -166,7 +165,7 @@ module internal ParseAndCheck = topAttrsOpt: TopAttribs option, tcImplFilesOpt: CheckedImplFile list option, compilerState) = let assemblyRef = mkSimpleAssemblyRef "stdin" let access = tcState.TcEnvFromImpls.AccessRights - let symbolUses = Choice2Of2 TcSymbolUses.Empty + let symbolUses = Choice2Of2 (async { return seq { } }) let dependencyFiles = parseResults |> Seq.map (fun x -> x.DependencyFiles) |> Array.concat let getAssemblyData () = None let details = (compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, tcState.CcuSig, symbolUses, topAttrsOpt, @@ -313,12 +312,12 @@ type InteractiveChecker internal (compilerStateCache) = let ctok = CompilationThreadToken() let flatErrors = compilerState.tcConfig.flatErrors let errors, diagnosticsLogger, _loggerProvider = CompileHelpers.mkCompilationDiagnosticsHandlers(flatErrors) - let exitCode = + let exnOpt = CompileHelpers.tryCompile diagnosticsLogger (fun exiter -> CompileFromTypedAst (ctok, compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, tcImplFiles, topAttrs, compilerState.tcConfig, outFile, diagnosticsLogger, exiter)) - return errors.ToArray(), exitCode + return errors.ToArray(), exnOpt } /// Parses and checks the whole project, good for compilers (Fable etc.) diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index 949eba27895..85bf6fd9f9d 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -1694,6 +1694,7 @@ module InfoMemberPrinting = |> PrintTypes.layoutCsharpCodeAnalysisIlAttributes denv (mi.RawMetadata.Return.CustomAttrs) (squareAngleReturn >> (@@)) let paramLayouts = minfo.GetParamDatas (amap, m, minst) + |> List.map (List.map fst) |> List.head |> List.zip (mi.ParamMetadata) |> List.map(fun (ilParams,paramData) -> diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index c9407a98174..bf6fa877173 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -1273,14 +1273,14 @@ let CompileFromTypedAst typedImplFiles, topAttrs, tcConfig: TcConfig, - outfile, + outfile: string, diagnosticsLogger, exiter: Exiter ) = let tcImportsCapture = None let dynamicAssemblyCreator = None - let assemblyName = Path.GetFileNameWithoutExtension(outfile) + let assemblyName = !! Path.GetFileNameWithoutExtension(outfile) // Doubling here tcImports as frameworkTcImports, seems to work... let frameworkTcImports = tcImports let pdbfile = None diff --git a/src/Compiler/Service/service.fsi b/src/Compiler/Service/service.fsi index e98f74a6029..244ab7483f6 100644 --- a/src/Compiler/Service/service.fsi +++ b/src/Compiler/Service/service.fsi @@ -23,7 +23,7 @@ open FSharp.Compiler.Driver module internal CompileHelpers = val mkCompilationDiagnosticsHandlers: bool -> ResizeArray * DiagnosticsLogger * IDiagnosticsLoggerProvider - val tryCompile: DiagnosticsLogger -> (StopProcessingExiter -> unit) -> int + val tryCompile: DiagnosticsLogger -> (StopProcessingExiter -> unit) -> exn option /// Used to parse and check F# source code. []