Skip to content

Commit 6235db3

Browse files
ncavencave
committed
Added service_slim
1 parent 97dd7cc commit 6235db3

13 files changed

+586
-5
lines changed

‎fcs/Directory.Build.props

+1-1
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@
3131
<!-- The LKG FSI.EXE requires MSBuild 15 to be installed, which is painful -->
3232
<ToolsetFsiToolPath>$(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.27\tools</ToolsetFsiToolPath>
3333
<ToolsetFsiToolExe>fsi.exe</ToolsetFsiToolExe>
34-
<FcsFSharpCorePkgVersion>4.6.2</FcsFSharpCorePkgVersion>
34+
<FcsFSharpCorePkgVersion>4.7.1</FcsFSharpCorePkgVersion>
3535
<FcsTargetNetFxFramework>net461</FcsTargetNetFxFramework>
3636
</PropertyGroup>
3737
</Project>

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

+1
Original file line numberDiff line numberDiff line change
@@ -714,6 +714,7 @@
714714
<Compile Include="$(FSharpSourcesRoot)\fsharp\fsi\fsi.fs">
715715
<Link>Service/fsi.fs</Link>
716716
</Compile>
717+
<Compile Include="service_slim.fs" />
717718
</ItemGroup>
718719
<ItemGroup>
719720
<PackageReference Include="FSharp.Core" Version="$(FcsFSharpCorePkgVersion)" />

‎fcs/FSharp.Compiler.Service/service_slim.fs

+243
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,243 @@
1+
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
2+
3+
namespace FSharp.Compiler.SourceCodeServices
4+
5+
open System
6+
open System.Collections.Concurrent
7+
open System.IO
8+
9+
open FSharp.Compiler
10+
open FSharp.Compiler.AbstractIL
11+
open FSharp.Compiler.AbstractIL.IL
12+
open FSharp.Compiler.AbstractIL.ILBinaryReader
13+
open FSharp.Compiler.AbstractIL.Internal.Library
14+
open FSharp.Compiler.AbstractIL.Internal.Utils
15+
open FSharp.Compiler.CompileOps
16+
open FSharp.Compiler.CompileOptions
17+
open FSharp.Compiler.CompilerGlobalState
18+
open FSharp.Compiler.Driver
19+
open FSharp.Compiler.ErrorLogger
20+
open FSharp.Compiler.Lib
21+
open FSharp.Compiler.NameResolution
22+
open FSharp.Compiler.Range
23+
open FSharp.Compiler.SyntaxTree
24+
open FSharp.Compiler.TcGlobals
25+
open FSharp.Compiler.Text
26+
open FSharp.Compiler.TypeChecker
27+
open FSharp.Compiler.TypedTree
28+
open FSharp.Compiler.TypedTreeOps
29+
30+
open Internal.Utilities
31+
open Internal.Utilities.Collections
32+
33+
//-------------------------------------------------------------------------
34+
// InteractiveChecker
35+
//-------------------------------------------------------------------------
36+
37+
type internal TcResult = TcEnv * TopAttribs * TypedImplFile option * ModuleOrNamespaceType
38+
type internal TcErrors = FSharpErrorInfo[]
39+
40+
type InteractiveChecker internal (tcConfig, tcGlobals, tcImports, tcInitialState, ctok, reactorOps, parseCache, checkCache) =
41+
let userOpName = "Unknown"
42+
let suggestNamesForErrors = true
43+
44+
static member Create(projectOptions: FSharpProjectOptions) =
45+
let tcConfig =
46+
let tcConfigB = TcConfigBuilder.Initial
47+
tcConfigB.implicitIncludeDir <- Path.GetDirectoryName(projectOptions.ProjectFileName)
48+
tcConfigB.legacyReferenceResolver <- SimulatedMSBuildReferenceResolver.getResolver()
49+
let sourceFiles = projectOptions.SourceFiles |> Array.toList
50+
let argv = projectOptions.OtherOptions |> Array.toList
51+
let _sourceFiles = ApplyCommandLineArgs(tcConfigB, sourceFiles, argv)
52+
TcConfig.Create(tcConfigB, validate=false)
53+
54+
let tcConfigP = TcConfigProvider.Constant(tcConfig)
55+
56+
let ctok = CompilationThreadToken()
57+
let tcGlobals, tcImports =
58+
TcImports.BuildTcImports (ctok, tcConfigP)
59+
|> Cancellable.runWithoutCancellation
60+
61+
let niceNameGen = NiceNameGenerator()
62+
let assemblyName = projectOptions.ProjectFileName |> System.IO.Path.GetFileNameWithoutExtension
63+
let tcInitialEnv = GetInitialTcEnv (assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals)
64+
let tcInitialState = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, niceNameGen, tcInitialEnv)
65+
66+
let reactorOps =
67+
{ new IReactorOperations with
68+
member __.EnqueueAndAwaitOpAsync (userOpName, opName, opArg, op) =
69+
async.Return (Cancellable.runWithoutCancellation (op ctok))
70+
member __.EnqueueOp (userOpName, opName, opArg, op) = (op ctok) }
71+
72+
// parse cache, keyed on file name and source hash
73+
let parseCache = ConcurrentDictionary<string * int, FSharpParseFileResults>(HashIdentity.Structural)
74+
// type check cache, keyed on file name
75+
let checkCache = ConcurrentDictionary<string, (TcResult * TcErrors) * (TcState * ModuleNamesDict)>(HashIdentity.Structural)
76+
77+
InteractiveChecker (tcConfig, tcGlobals, tcImports, tcInitialState, ctok, reactorOps, parseCache, checkCache)
78+
79+
member private x.MakeProjectResults (projectFileName: string, parseResults: FSharpParseFileResults[], tcState: TcState, errors: FSharpErrorInfo[],
80+
symbolUses: TcSymbolUses list, topAttrsOpt: TopAttribs option, tcImplFilesOpt: TypedImplFile list option) =
81+
let assemblyRef = mkSimpleAssemblyRef "stdin"
82+
let assemblyDataOpt = None
83+
let access = tcState.TcEnvFromImpls.AccessRights
84+
let dependencyFiles = parseResults |> Seq.map (fun x -> x.DependencyFiles) |> Array.concat
85+
let details = (tcGlobals, tcImports, tcState.Ccu, tcState.CcuSig, symbolUses, topAttrsOpt, assemblyDataOpt, assemblyRef, access, tcImplFilesOpt, dependencyFiles)
86+
let keepAssemblyContents = true
87+
FSharpCheckProjectResults (projectFileName, Some tcConfig, keepAssemblyContents, errors, Some details)
88+
89+
member private x.ClearStaleCache (fileName: string, parsingOptions: FSharpParsingOptions) =
90+
let fileIndex = parsingOptions.SourceFiles |> Array.findIndex ((=) fileName)
91+
let filesAbove = parsingOptions.SourceFiles |> Array.take fileIndex
92+
// backup all cached typecheck entries above file
93+
let cachedAbove = filesAbove |> Array.choose (fun key ->
94+
match checkCache.TryGetValue(key) with
95+
| true, value -> Some (key, value)
96+
| false, _ -> None)
97+
// remove all parse cache entries with the same file name
98+
let staleParseKeys = parseCache.Keys |> Seq.filter (fun (n,_) -> n = fileName) |> Seq.toArray
99+
staleParseKeys |> Array.iter (fun key -> parseCache.TryRemove(key) |> ignore)
100+
checkCache.Clear(); // clear all typecheck cache
101+
// restore all cached typecheck entries above file
102+
cachedAbove |> Array.iter (fun (key, value) -> checkCache.TryAdd(key, value) |> ignore)
103+
104+
member private x.ParseFile (fileName: string, sourceHash: int, source: Lazy<string>, parsingOptions: FSharpParsingOptions) =
105+
let parseCacheKey = fileName, sourceHash
106+
parseCache.GetOrAdd(parseCacheKey, fun _ ->
107+
x.ClearStaleCache(fileName, parsingOptions)
108+
let sourceText = SourceText.ofString source.Value
109+
let parseErrors, parseTreeOpt, anyErrors = ParseAndCheckFile.parseFile (sourceText, fileName, parsingOptions, userOpName, suggestNamesForErrors)
110+
let dependencyFiles = [||] // interactions have no dependencies
111+
FSharpParseFileResults (parseErrors, parseTreeOpt, anyErrors, dependencyFiles) )
112+
113+
member private x.TypeCheckOneInput (parseResults: FSharpParseFileResults, tcSink: TcResultsSink, tcState: TcState, moduleNamesDict: ModuleNamesDict) =
114+
let input = parseResults.ParseTree.Value
115+
let capturingErrorLogger = CompilationErrorLogger("TypeCheckFile", tcConfig.errorSeverityOptions)
116+
let errorLogger = GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput(input), capturingErrorLogger)
117+
use _errorScope = new CompilationGlobalsScope (errorLogger, BuildPhase.TypeCheck)
118+
119+
let checkForErrors () = parseResults.ParseHadErrors || errorLogger.ErrorCount > 0
120+
let prefixPathOpt = None
121+
122+
let input, moduleNamesDict = input |> DeduplicateParsedInputModuleName moduleNamesDict
123+
let tcResult, tcState =
124+
TypeCheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input)
125+
|> Eventually.force ctok
126+
127+
let fileName = parseResults.FileName
128+
let tcErrors = ErrorHelpers.CreateErrorInfos (tcConfig.errorSeverityOptions, false, fileName, (capturingErrorLogger.GetErrors()), suggestNamesForErrors)
129+
(tcResult, tcErrors), (tcState, moduleNamesDict)
130+
131+
member private x.CheckFile (projectFileName: string, parseResults: FSharpParseFileResults, tcState: TcState, moduleNamesDict: ModuleNamesDict) =
132+
match parseResults.ParseTree with
133+
| Some _input ->
134+
let sink = TcResultsSinkImpl(tcGlobals)
135+
let tcSink = TcResultsSink.WithSink sink
136+
let (tcResult, tcErrors), (tcState, moduleNamesDict) =
137+
x.TypeCheckOneInput (parseResults, tcSink, tcState, moduleNamesDict)
138+
let fileName = parseResults.FileName
139+
checkCache.[fileName] <- ((tcResult, tcErrors), (tcState, moduleNamesDict))
140+
141+
let loadClosure = None
142+
let textSnapshotInfo = None
143+
let keepAssemblyContents = true
144+
145+
let tcEnvAtEnd, _topAttrs, implFile, ccuSigForFile = tcResult
146+
let errors = Array.append parseResults.Errors tcErrors
147+
148+
let scope = TypeCheckInfo (tcConfig, tcGlobals, ccuSigForFile, tcState.Ccu, tcImports, tcEnvAtEnd.AccessRights,
149+
projectFileName, fileName, sink.GetResolutions(), sink.GetSymbolUses(), tcEnvAtEnd.NameEnv,
150+
loadClosure, reactorOps, textSnapshotInfo, implFile, sink.GetOpenDeclarations())
151+
FSharpCheckFileResults (fileName, errors, Some scope, parseResults.DependencyFiles, None, reactorOps, keepAssemblyContents)
152+
|> Some
153+
| None ->
154+
None
155+
156+
member private x.TypeCheckClosedInputSet (parseResults: FSharpParseFileResults[], tcState) =
157+
let cachedTypeCheck (tcState, moduleNamesDict) (parseRes: FSharpParseFileResults) =
158+
let checkCacheKey = parseRes.FileName
159+
let typeCheckOneInput _fileName =
160+
x.TypeCheckOneInput (parseRes, TcResultsSink.NoSink, tcState, moduleNamesDict)
161+
checkCache.GetOrAdd(checkCacheKey, typeCheckOneInput)
162+
let results, (tcState, moduleNamesDict) =
163+
((tcState, Map.empty), parseResults) ||> Array.mapFold cachedTypeCheck
164+
let tcResults, tcErrors = Array.unzip results
165+
let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _ccuSigsForFiles), tcState =
166+
TypeCheckMultipleInputsFinish(tcResults |> Array.toList, tcState)
167+
let tcState, declaredImpls = TypeCheckClosedInputSetFinish (implFiles, tcState)
168+
tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile, moduleNamesDict, tcErrors
169+
170+
/// Errors grouped by file, sorted by line, column
171+
member private x.ErrorsByFile (fileNames: string[], errorList: FSharpErrorInfo[] list) =
172+
let errorMap = errorList |> Array.concat |> Array.groupBy (fun x -> x.FileName) |> Map.ofArray
173+
let errors = fileNames |> Array.choose errorMap.TryFind
174+
errors |> Array.iter (Array.sortInPlaceBy (fun x -> x.StartLineAlternate, x.StartColumn))
175+
errors |> Array.concat
176+
177+
/// Clears parse and typecheck caches.
178+
member x.ClearCache () =
179+
parseCache.Clear()
180+
checkCache.Clear()
181+
182+
/// Parses and checks the whole project, good for compilers (Fable etc.)
183+
/// Does not retain name resolutions and symbol uses which are quite memory hungry (so no intellisense etc.).
184+
/// Already parsed files will be cached so subsequent compilations will be faster.
185+
member x.ParseAndCheckProject (projectFileName: string, fileNames: string[], sourceReader: string->int*Lazy<string>) =
186+
// parse files
187+
let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, fileNames, false)
188+
let parseResults = fileNames |> Array.map (fun fileName ->
189+
let sourceHash, source = sourceReader fileName
190+
x.ParseFile(fileName, sourceHash, source, parsingOptions))
191+
192+
// type check files
193+
let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, _moduleNamesDict, tcErrors =
194+
x.TypeCheckClosedInputSet (parseResults, tcInitialState)
195+
196+
// make project results
197+
let parseErrors = parseResults |> Array.collect (fun p -> p.Errors)
198+
let typedErrors = tcErrors |> Array.concat
199+
let errors = x.ErrorsByFile (fileNames, [ parseErrors; typedErrors ])
200+
let symbolUses = [] //TODO:
201+
let projectResults = x.MakeProjectResults (projectFileName, parseResults, tcState, errors, symbolUses, Some topAttrs, Some tcImplFiles)
202+
203+
projectResults
204+
205+
/// Parses and checks file in project, will compile and cache all the files up to this one
206+
/// (if not already done before), or fetch them from cache. Returns partial project results,
207+
/// up to and including the file requested. Returns parse and typecheck results containing
208+
/// name resolutions and symbol uses for the file requested only, so intellisense etc. works.
209+
member x.ParseAndCheckFileInProject (fileName: string, projectFileName: string, fileNames: string[], sources: string[]) =
210+
// get files before file
211+
let fileIndex = fileNames |> Array.findIndex ((=) fileName)
212+
let fileNamesBeforeFile = fileNames |> Array.take fileIndex
213+
let sourcesBeforeFile = sources |> Array.take fileIndex
214+
215+
// parse files before file
216+
let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, fileNames, false)
217+
let parseFile (fileName, source) = x.ParseFile (fileName, hash source, lazy source, parsingOptions)
218+
let parseResults = Array.zip fileNamesBeforeFile sourcesBeforeFile |> Array.map parseFile
219+
220+
// type check files before file
221+
let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, moduleNamesDict, tcErrors =
222+
x.TypeCheckClosedInputSet (parseResults, tcInitialState)
223+
224+
// parse and type check file
225+
let parseFileResults = parseFile (fileName, sources.[fileIndex])
226+
let checkFileResults = x.CheckFile (projectFileName, parseFileResults, tcState, moduleNamesDict)
227+
let (tcResult, _tcErrors), (tcState, _moduleNamesDict) = checkCache.[fileName]
228+
let _tcEnvAtEndFile, topAttrsFile, implFile, _ccuSigForFile = tcResult
229+
230+
// collect errors
231+
let parseErrorsBefore = parseResults |> Array.collect (fun p -> p.Errors)
232+
let typedErrorsBefore = tcErrors |> Array.concat
233+
let newErrors = match checkFileResults with | Some res -> res.Errors | None -> [||]
234+
let errors = x.ErrorsByFile (fileNames, [ parseErrorsBefore; typedErrorsBefore; newErrors ])
235+
236+
// make partial project results
237+
let parseResults = Array.append parseResults [| parseFileResults |]
238+
let tcImplFiles = List.append tcImplFiles (Option.toList implFile)
239+
let topAttrs = CombineTopAttrs topAttrsFile topAttrs
240+
let symbolUses = [] //TODO:
241+
let projectResults = x.MakeProjectResults (projectFileName, parseResults, tcState, errors, symbolUses, Some topAttrs, Some tcImplFiles)
242+
243+
parseFileResults, checkFileResults, projectResults

0 commit comments

Comments
 (0)