Skip to content

Commit

Permalink
Added service_slim
Browse files Browse the repository at this point in the history
  • Loading branch information
ncave committed Aug 5, 2019
1 parent 7c7a87b commit d08a3fe
Show file tree
Hide file tree
Showing 12 changed files with 607 additions and 4 deletions.
1 change: 1 addition & 0 deletions fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj
Original file line number Diff line number Diff line change
Expand Up @@ -657,6 +657,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)" />
Expand Down
261 changes: 261 additions & 0 deletions fcs/FSharp.Compiler.Service/service_slim.fs
Original file line number Diff line number Diff line change
@@ -0,0 +1,261 @@
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.

// Open up the compiler as an incremental service for parsing,
// type checking and intellisense-like environment-reporting.

namespace FSharp.Compiler.SourceCodeServices

open System
open System.Collections.Generic
open System.Collections.Concurrent
open System.Diagnostics
open System.IO
open System.Reflection
open System.Text

open Microsoft.FSharp.Core.Printf
open FSharp.Compiler
open FSharp.Compiler.AbstractIL
open FSharp.Compiler.AbstractIL.IL
open FSharp.Compiler.AbstractIL.ILBinaryReader
open FSharp.Compiler.AbstractIL.Diagnostics
open FSharp.Compiler.AbstractIL.Internal
open FSharp.Compiler.AbstractIL.Internal.Library

open FSharp.Compiler.AccessibilityLogic
open FSharp.Compiler.Ast
open FSharp.Compiler.CompileOps
open FSharp.Compiler.CompileOptions
open FSharp.Compiler.Driver
open FSharp.Compiler.ErrorLogger
open FSharp.Compiler.Lib
open FSharp.Compiler.PrettyNaming
open FSharp.Compiler.Parser
open FSharp.Compiler.Range
open FSharp.Compiler.Lexhelp
open FSharp.Compiler.Layout
open FSharp.Compiler.Tast
open FSharp.Compiler.Tastops
open FSharp.Compiler.TcGlobals
open FSharp.Compiler.Text
open FSharp.Compiler.Infos
open FSharp.Compiler.InfoReader
open FSharp.Compiler.NameResolution
open FSharp.Compiler.TypeChecker
open FSharp.Compiler.SourceCodeServices.SymbolHelpers

open Internal.Utilities
open Internal.Utilities.Collections
open FSharp.Compiler.Layout.TaggedTextOps

//-------------------------------------------------------------------------
// 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
6 changes: 5 additions & 1 deletion fcs/build.fsx
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,7 @@ let dotnetExePath =
if File.Exists(pathToCli) then
pathToCli
else
DotNetCli.InstallDotNetSDK "2.2.105"
DotNetCli.InstallDotNetSDK "2.2.108"

let runDotnet workingDir args =
let result =
Expand Down Expand Up @@ -90,6 +90,10 @@ Target "BuildVersion" (fun _ ->
Shell.Exec("appveyor", sprintf "UpdateBuild -Version \"%s\"" buildVersion) |> ignore
)

Target "BuildTools" (fun _ ->
runDotnet __SOURCE_DIRECTORY__ "build ../src/buildtools/buildtools.proj -v n -c Proto"
)

Target "Build" (fun _ ->
runDotnet __SOURCE_DIRECTORY__ "build ../src/buildtools/buildtools.proj -v n -c Proto"
let fslexPath = __SOURCE_DIRECTORY__ + "/../artifacts/bin/fslex/Proto/netcoreapp2.1/fslex.dll"
Expand Down
Loading

0 comments on commit d08a3fe

Please sign in to comment.