From aabca4b03e0c70acc88608b1def11ac1de181480 Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Mon, 26 Oct 2020 22:21:14 -0700 Subject: [PATCH] Added service_slim --- .vscode/launch.json | 18 ++ eng/Versions.props | 4 +- fcs/build.sh | 4 + fcs/fcs-test/Program.fs | 127 +++++++++ fcs/fcs-test/Properties/launchSettings.json | 8 + fcs/fcs-test/ast_print.fs | 101 +++++++ fcs/fcs-test/fcs-test.fsproj | 26 ++ fcs/fcs-test/test_script.fsx | 8 + src/buildtools/buildtools.targets | 4 +- .../FSharp.Compiler.Service.fsproj | 1 + .../FSharp.Compiler.Service/service_slim.fs | 252 ++++++++++++++++++ src/fsharp/service/FSharpCheckerResults.fsi | 38 +++ 12 files changed, 587 insertions(+), 4 deletions(-) create mode 100644 .vscode/launch.json create mode 100644 fcs/build.sh create mode 100644 fcs/fcs-test/Program.fs create mode 100644 fcs/fcs-test/Properties/launchSettings.json 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 src/fsharp/FSharp.Compiler.Service/service_slim.fs diff --git a/.vscode/launch.json b/.vscode/launch.json new file mode 100644 index 000000000000..3628a3ca174d --- /dev/null +++ b/.vscode/launch.json @@ -0,0 +1,18 @@ +{ + // Use IntelliSense to learn about possible attributes. + // Hover to view descriptions of existing attributes. + // For more information, visit: https://go.microsoft.com/fwlink/?linkid=830387 + "version": "0.2.0", + "configurations": [ + { + "name": ".NET Core Launch (console)", + "type": "coreclr", + "request": "launch", + "program": "${workspaceFolder}/artifacts/bin/fcs-test/Debug/netcoreapp3.1/fcs-test.dll", + "args": [], + "cwd": "${workspaceFolder}/fcs/fcs-test", + "console": "internalConsole", + "stopAtEntry": false + } + ] +} \ No newline at end of file diff --git a/eng/Versions.props b/eng/Versions.props index 4d4f0b03af3d..b4fcb9799107 100644 --- a/eng/Versions.props +++ b/eng/Versions.props @@ -68,7 +68,7 @@ 4.5.1 - 5.0.0-preview.8.20407.11 + 1.7.1 4.3.0 4.3.0 4.0.0 @@ -81,7 +81,7 @@ 4.3.0 4.3.0 4.3.0 - 5.0.0-preview.8.20407.11 + 1.8.1 4.3.0 1.5.0 4.3.0 diff --git a/fcs/build.sh b/fcs/build.sh new file mode 100644 index 000000000000..d027a7f7acbb --- /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/Program.fs b/fcs/fcs-test/Program.fs new file mode 100644 index 000000000000..e59e47a0dd67 --- /dev/null +++ b/fcs/fcs-test/Program.fs @@ -0,0 +1,127 @@ +open System.IO +open System.Collections.Generic +open FSharp.Compiler +open FSharp.Compiler.SourceCodeServices + +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) = + { ProjectFileName = projName + ProjectId = None + SourceFiles = [| |] + OtherOptions = argv + ReferencedProjects = [| |] + IsIncompleteTypeCheckEnvironment = false + UseScriptResolutionRules = false + LoadTime = System.DateTime.MaxValue + UnresolvedReferences = None + OriginalLoadReferences = [] + ExtraProjectInfo = None + 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 projectResults = checker.ParseAndCheckProject(projName, fileNames, sources) + // projectResults.Errors |> Array.iter (fun e -> printfn "%A: %A" (e.Severity) e) + // printAst "ParseAndCheckProject" projectResults + + // or just parse and typecheck a file in project + let parseResults, tcResultsOpt, projectResults = + checker.ParseAndCheckFileInProject(fileName, projName, fileNames, sources) + projectResults.Errors |> Array.iter (fun e -> printfn "%A: %A" (e.Severity) e) + + match tcResultsOpt with + | Some typeCheckResults -> + printAst "ParseAndCheckFileInProject" projectResults + + let inputLines = source.Split('\n') + async { + // Get tool tip at the specified location + let! tip = typeCheckResults.GetToolTipText(4, 7, inputLines.[3], ["foo"], FSharpTokenTag.IDENT) + (sprintf "%A" tip).Replace("\n","") |> printfn "\n---> ToolTip Text = %A" // should be "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 _ -> []), fun _ -> false) + [ for item in decls.Items -> item.Name ] |> printfn "\n---> msg AutoComplete = %A" // should be 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 _ -> []), fun _ -> false) + [ for item in decls.Items -> item.Name ] |> printfn "\n---> canvas AutoComplete = %A" + } |> Async.StartImmediate + + | _ -> () + 0 diff --git a/fcs/fcs-test/Properties/launchSettings.json b/fcs/fcs-test/Properties/launchSettings.json new file mode 100644 index 000000000000..06e83994e879 --- /dev/null +++ b/fcs/fcs-test/Properties/launchSettings.json @@ -0,0 +1,8 @@ +{ + "profiles": { + "fcs-test": { + "commandName": "Project", + "workingDirectory": "$(SolutionDir)" + } + } +} \ No newline at end of file diff --git a/fcs/fcs-test/ast_print.fs b/fcs/fcs-test/ast_print.fs new file mode 100644 index 000000000000..bf936a8d48d4 --- /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. + +namespace FSharp.Compiler.SourceCodeServices + +//------------------------------------------------------------------------- +// AstPrint +//------------------------------------------------------------------------- + +module 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 000000000000..d2edd44b06d3 --- /dev/null +++ b/fcs/fcs-test/fcs-test.fsproj @@ -0,0 +1,26 @@ + + + + Exe + netcoreapp3.1 + true + + + + + + + + + + + + + + + + + + + + diff --git a/fcs/fcs-test/test_script.fsx b/fcs/fcs-test/test_script.fsx new file mode 100644 index 000000000000..1bbe729ab75a --- /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/src/buildtools/buildtools.targets b/src/buildtools/buildtools.targets index 86346fc2a156..25effd1d61e2 100644 --- a/src/buildtools/buildtools.targets +++ b/src/buildtools/buildtools.targets @@ -20,7 +20,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\Bootstrap\fslex\fslex.dll + $(ArtifactsDir)\bin\fslex\Release\netcoreapp3.1\fslex.dll @@ -44,7 +44,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\Bootstrap\fsyacc\fsyacc.dll + $(ArtifactsDir)\bin\fsyacc\Release\netcoreapp3.1\fsyacc.dll diff --git a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj index 2f7d9d26d304..7dcfcd39406c 100644 --- a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj +++ b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj @@ -762,6 +762,7 @@ InteractiveSession/fsi.fs + diff --git a/src/fsharp/FSharp.Compiler.Service/service_slim.fs b/src/fsharp/FSharp.Compiler.Service/service_slim.fs new file mode 100644 index 000000000000..2e4673002470 --- /dev/null +++ b/src/fsharp/FSharp.Compiler.Service/service_slim.fs @@ -0,0 +1,252 @@ +// 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 FSharp.Compiler +open FSharp.Compiler.AbstractIL +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.AbstractIL.ILBinaryReader +open FSharp.Compiler.AbstractIL.Internal.Library +open FSharp.Compiler.AbstractIL.Internal.Utils +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.Driver +open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Lib +open FSharp.Compiler.NameResolution +open FSharp.Compiler.ParseAndCheckInputs +open FSharp.Compiler.Range +open FSharp.Compiler.ScriptClosure +open FSharp.Compiler.SyntaxTree +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.Text +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeBasics +open FSharp.Compiler.TypedTreeOps + +open Microsoft.DotNet.DependencyManager + +open Internal.Utilities +open Internal.Utilities.Collections + +//------------------------------------------------------------------------- +// InteractiveChecker +//------------------------------------------------------------------------- + +type internal TcResult = TcEnv * TopAttribs * TypedImplFile option * ModuleOrNamespaceType +type internal TcErrors = FSharpErrorInfo[] + +type InteractiveChecker internal (tcConfig, tcGlobals, tcImports, tcInitialState, ctok, reactorOps, parseCache, checkCache) = + let userOpName = "Unknown" + let suggestNamesForErrors = true + + static member Create(projectOptions: FSharpProjectOptions) = + let tcConfig = + let tcConfigB = TcConfigBuilder.Initial + tcConfigB.implicitIncludeDir <- Path.GetDirectoryName(projectOptions.ProjectFileName) + tcConfigB.legacyReferenceResolver <- SimulatedMSBuildReferenceResolver.getResolver() + 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 + + 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 reactorOps = + { new IReactorOperations with + member __.EnqueueAndAwaitOpAsync (userOpName, opName, opArg, op) = + async.Return (Cancellable.runWithoutCancellation (op ctok)) + member __.EnqueueOp (userOpName, opName, opArg, op) = (op ctok) } + + // 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) + + InteractiveChecker (tcConfig, tcGlobals, tcImports, tcInitialState, ctok, reactorOps, parseCache, checkCache) + + member private x.MakeProjectResults (projectFileName: string, parseResults: FSharpParseFileResults[], tcState: TcState, errors: FSharpErrorInfo[], + symbolUses: TcSymbolUses list, topAttrsOpt: TopAttribs option, tcImplFilesOpt: TypedImplFile list option) = + 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 = (tcGlobals, tcImports, tcState.Ccu, tcState.CcuSig, symbolUses, topAttrsOpt, assemblyDataOpt, assemblyRef, access, tcImplFilesOpt, dependencyFiles) + let keepAssemblyContents = true + FSharpCheckProjectResults (projectFileName, Some tcConfig, keepAssemblyContents, errors, Some details) + + member private x.ClearStaleCache (fileName: string, parsingOptions: FSharpParsingOptions) = + 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 checkCache.TryGetValue(key) with + | true, value -> Some (key, value) + | false, _ -> None) + // remove all parse cache entries with the same file name + let staleParseKeys = parseCache.Keys |> Seq.filter (fun (n,_) -> n = fileName) |> Seq.toArray + staleParseKeys |> Array.iter (fun key -> parseCache.TryRemove(key) |> ignore) + checkCache.Clear(); // clear all typecheck cache + // restore all cached typecheck entries above file + cachedAbove |> Array.iter (fun (key, value) -> checkCache.TryAdd(key, value) |> ignore) + + member private x.ParseFile (fileName: string, sourceHash: int, source: Lazy, parsingOptions: FSharpParsingOptions) = + let parseCacheKey = fileName, sourceHash + parseCache.GetOrAdd(parseCacheKey, fun _ -> + x.ClearStaleCache(fileName, parsingOptions) + 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) ) + + member private x.TypeCheckOneInput (parseResults: FSharpParseFileResults, tcSink: TcResultsSink, tcState: TcState, moduleNamesDict: ModuleNamesDict) = + let input = parseResults.ParseTree.Value + let capturingErrorLogger = CompilationErrorLogger("TypeCheckFile", 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, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input, false) + |> Eventually.force ctok + + let fileName = parseResults.FileName + let tcErrors = ErrorHelpers.CreateErrorInfos (tcConfig.errorSeverityOptions, false, fileName, (capturingErrorLogger.GetErrors()), suggestNamesForErrors) + (tcResult, tcErrors), (tcState, moduleNamesDict) + + member private x.CheckFile (projectFileName: string, parseResults: FSharpParseFileResults, tcState: TcState, moduleNamesDict: ModuleNamesDict) = + match parseResults.ParseTree with + | Some _input -> + let sink = TcResultsSinkImpl(tcGlobals) + let tcSink = TcResultsSink.WithSink sink + let (tcResult, tcErrors), (tcState, moduleNamesDict) = + x.TypeCheckOneInput (parseResults, tcSink, tcState, moduleNamesDict) + let fileName = parseResults.FileName + checkCache.[fileName] <- ((tcResult, tcErrors), (tcState, moduleNamesDict)) + + let loadClosure = None + let textSnapshotInfo = None + let keepAssemblyContents = true + + let tcEnvAtEnd, _topAttrs, implFile, ccuSigForFile = tcResult + let errors = Array.append parseResults.Errors tcErrors + + let scope = TypeCheckInfo (tcConfig, tcGlobals, ccuSigForFile, tcState.Ccu, tcImports, tcEnvAtEnd.AccessRights, + projectFileName, fileName, sink.GetResolutions(), sink.GetSymbolUses(), tcEnvAtEnd.NameEnv, + loadClosure, reactorOps, textSnapshotInfo, implFile, sink.GetOpenDeclarations()) + FSharpCheckFileResults (fileName, errors, Some scope, parseResults.DependencyFiles, None, reactorOps, keepAssemblyContents) + |> Some + | None -> + None + + member private x.TypeCheckClosedInputSet (parseResults: FSharpParseFileResults[], tcState) = + let cachedTypeCheck (tcState, moduleNamesDict) (parseRes: FSharpParseFileResults) = + let checkCacheKey = parseRes.FileName + let typeCheckOneInput _fileName = + x.TypeCheckOneInput (parseRes, TcResultsSink.NoSink, tcState, moduleNamesDict) + 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 + member private x.ErrorsByFile (fileNames: string[], errorList: FSharpErrorInfo[] 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.StartLineAlternate, x.StartColumn)) + errors |> Array.concat + + /// Clears parse and typecheck caches. + member x.ClearCache () = + parseCache.Clear() + 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 x.ParseAndCheckProject (projectFileName: string, fileNames: string[], sourceReader: string->int*Lazy) = + // parse files + let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, fileNames, false) + let parseResults = fileNames |> Array.map (fun fileName -> + let sourceHash, source = sourceReader fileName + x.ParseFile(fileName, sourceHash, source, parsingOptions)) + + // type check files + let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, _moduleNamesDict, tcErrors = + x.TypeCheckClosedInputSet (parseResults, tcInitialState) + + // make project results + let parseErrors = parseResults |> Array.collect (fun p -> p.Errors) + let typedErrors = tcErrors |> Array.concat + let errors = x.ErrorsByFile (fileNames, [ parseErrors; typedErrors ]) + let symbolUses = [] //TODO: + let projectResults = x.MakeProjectResults (projectFileName, parseResults, tcState, errors, symbolUses, Some topAttrs, Some tcImplFiles) + + 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 x.ParseAndCheckFileInProject (fileName: string, projectFileName: string, fileNames: string[], sources: string[]) = + // 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(tcConfig, fileNames, false) + let parseFile (fileName, source) = x.ParseFile (fileName, hash source, lazy source, parsingOptions) + let parseResults = Array.zip fileNamesBeforeFile sourcesBeforeFile |> Array.map parseFile + + // type check files before file + let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, moduleNamesDict, tcErrors = + x.TypeCheckClosedInputSet (parseResults, tcInitialState) + + // parse and type check file + let parseFileResults = parseFile (fileName, sources.[fileIndex]) + let checkFileResults = x.CheckFile (projectFileName, parseFileResults, tcState, moduleNamesDict) + let (tcResult, _tcErrors), (tcState, _moduleNamesDict) = checkCache.[fileName] + let _tcEnvAtEndFile, topAttrsFile, implFile, _ccuSigForFile = tcResult + + // collect errors + let parseErrorsBefore = parseResults |> Array.collect (fun p -> p.Errors) + let typedErrorsBefore = tcErrors |> Array.concat + let newErrors = match checkFileResults with | Some res -> res.Errors | None -> [||] + let errors = x.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 = x.MakeProjectResults (projectFileName, parseResults, tcState, errors, symbolUses, Some topAttrs, Some tcImplFiles) + + parseFileResults, checkFileResults, projectResults diff --git a/src/fsharp/service/FSharpCheckerResults.fsi b/src/fsharp/service/FSharpCheckerResults.fsi index 52e241a61b17..e121915d8ef4 100644 --- a/src/fsharp/service/FSharpCheckerResults.fsi +++ b/src/fsharp/service/FSharpCheckerResults.fsi @@ -75,9 +75,47 @@ 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 * + sResolutions: TcResolutions * + sSymbolUses: TcSymbolUses * + sFallback: NameResolutionEnv * + loadClosure : LoadClosure option * + reactorOps : IReactorOperations * + textSnapshotInfo: obj 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: FSharpErrorInfo[] * + scopeOptX: TypeCheckInfo option * + dependencyFiles: string[] * + builderX: IncrementalBuilder option * + reactorOpsX: IReactorOperations * + keepAssemblyContents: bool + -> FSharpCheckFileResults + /// The errors returned by parsing a source file. member Errors : FSharpErrorInfo[]