Witnesses

fcs/Directory.Build.props

@@ -31,7 +31,7 @@
     <!-- The LKG FSI.EXE requires MSBuild 15 to be installed, which is painful -->
     <ToolsetFsiToolPath>$(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.27\tools</ToolsetFsiToolPath>
     <ToolsetFsiToolExe>fsi.exe</ToolsetFsiToolExe>
-    <FcsFSharpCorePkgVersion>4.6.2</FcsFSharpCorePkgVersion>
+    <FcsFSharpCorePkgVersion>4.7.1</FcsFSharpCorePkgVersion>
     <FcsTargetNetFxFramework>net461</FcsTargetNetFxFramework>
   </PropertyGroup>
 </Project>

fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj

@@ -715,6 +715,7 @@
     <Compile Include="$(FSharpSourcesRoot)\fsharp\fsi\fsi.fs">
       <Link>Service/fsi.fs</Link>
     </Compile>
+    <Compile Include="service_slim.fs" />
   </ItemGroup>
   <ItemGroup>
     <PackageReference Include="FSharp.Core" Version="$(FcsFSharpCorePkgVersion)" />

fcs/FSharp.Compiler.Service/service_slim.fs

@@ -0,0 +1,243 @@
+// 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.CompileOps
+open FSharp.Compiler.CompileOptions
+open FSharp.Compiler.CompilerGlobalState
+open FSharp.Compiler.Driver
+open FSharp.Compiler.ErrorLogger
+open FSharp.Compiler.Lib
+open FSharp.Compiler.NameResolution
+open FSharp.Compiler.Range
+open FSharp.Compiler.SyntaxTree
+open FSharp.Compiler.TcGlobals
+open FSharp.Compiler.Text
+open FSharp.Compiler.TypeChecker
+open FSharp.Compiler.TypedTree
+open FSharp.Compiler.TypedTreeOps
+
+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 tcGlobals, tcImports =
+            TcImports.BuildTcImports (ctok, tcConfigP)
+            |> Cancellable.runWithoutCancellation
+
+        let niceNameGen = NiceNameGenerator()
+        let assemblyName = projectOptions.ProjectFileName |> System.IO.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<string * int, FSharpParseFileResults>(HashIdentity.Structural)
+        // type check cache, keyed on file name
+        let checkCache = ConcurrentDictionary<string, (TcResult * TcErrors) * (TcState * ModuleNamesDict)>(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<string>, 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)
+            |> 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<string>) =
+        // 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