From 1ac794745bebd7755d0a40a92b0d3d065b414d18 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 25 Feb 2021 18:18:52 +0000 Subject: [PATCH 01/15] incorporate cleanup related to analyzers --- src/fsharp/CheckDeclarations.fs | 8 +- src/fsharp/CheckExpressions.fs | 2 +- src/fsharp/CompilerDiagnostics.fs | 43 +-- src/fsharp/CompilerDiagnostics.fsi | 8 +- src/fsharp/CompilerImports.fs | 38 +++ src/fsharp/CompilerImports.fsi | 24 +- src/fsharp/CompilerOptions.fs | 9 +- src/fsharp/CompilerOptions.fsi | 41 +-- src/fsharp/Diagnostics.fs | 9 +- src/fsharp/Diagnostics.fsi | 7 + src/fsharp/ErrorLogger.fs | 60 ++-- src/fsharp/ErrorLogger.fsi | 11 +- src/fsharp/ExtensionTyping.fs | 2 +- src/fsharp/LegacyHostedCompilerForTesting.fs | 9 +- src/fsharp/MethodCalls.fs | 2 +- src/fsharp/ParseAndCheckInputs.fs | 95 +++--- src/fsharp/ParseAndCheckInputs.fsi | 9 +- src/fsharp/ScriptClosure.fs | 52 ++-- src/fsharp/ScriptClosure.fsi | 11 +- src/fsharp/SyntaxTree.fs | 5 + src/fsharp/SyntaxTree.fsi | 3 + src/fsharp/fsc.fs | 79 ++--- src/fsharp/fsc.fsi | 10 - src/fsharp/fsi/fsi.fs | 22 +- src/fsharp/import.fs | 4 +- src/fsharp/service/ExternalSymbol.fsi | 10 +- src/fsharp/service/FSharpCheckerResults.fs | 193 ++++++++----- src/fsharp/service/FSharpCheckerResults.fsi | 81 +++++- src/fsharp/service/FSharpParseFileResults.fs | 270 ++++++++---------- src/fsharp/service/FSharpParseFileResults.fsi | 4 +- src/fsharp/service/IncrementalBuild.fs | 204 ++++++------- src/fsharp/service/IncrementalBuild.fsi | 17 +- src/fsharp/service/ServiceParsedInputOps.fs | 27 +- src/fsharp/service/ServiceParsedInputOps.fsi | 6 +- src/fsharp/service/ServiceXmlDocParser.fs | 9 +- src/fsharp/service/ServiceXmlDocParser.fsi | 2 +- src/fsharp/service/service.fs | 176 +++++------- src/fsharp/service/service.fsi | 47 --- src/fsharp/symbols/SymbolHelpers.fs | 61 ++-- src/fsharp/symbols/SymbolHelpers.fsi | 29 +- src/fsharp/symbols/Symbols.fs | 10 +- src/fsharp/utils/CompilerLocationUtils.fs | 14 +- src/fsharp/utils/CompilerLocationUtils.fsi | 3 +- .../SurfaceArea.netstandard.fs | 25 +- .../CompilerTestHelpers.fs | 1 - .../HashIfExpression.fs | 3 +- tests/FSharp.Test.Utilities/CompilerAssert.fs | 6 +- tests/service/Common.fs | 5 +- tests/service/InteractiveCheckerTests.fs | 4 +- tests/service/ProjectAnalysisTests.fs | 1 + tests/service/ServiceUntypedParseTests.fs | 14 +- tests/service/StructureTests.fs | 21 +- tests/service/Symbols.fs | 38 ++- tests/service/TreeVisitorTests.fs | 5 +- .../Commands/XmlDocCommandService.fs | 2 +- .../src/FSharp.Editor/Common/RoslynHelpers.fs | 9 +- .../Completion/CompletionProvider.fs | 5 +- .../FSharpCheckerExtensions.fs | 6 +- .../Navigation/NavigateToSearchService.fs | 23 +- 59 files changed, 992 insertions(+), 902 deletions(-) diff --git a/src/fsharp/CheckDeclarations.fs b/src/fsharp/CheckDeclarations.fs index fa31e63a708..bb7813857c4 100644 --- a/src/fsharp/CheckDeclarations.fs +++ b/src/fsharp/CheckDeclarations.fs @@ -5026,7 +5026,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS | SynModuleSigDecl.Val (vspec, m) -> let parentModule = match parent with - | ParentNone -> error(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(), vspec.RangeOfId)) + | ParentNone -> error(Error(FSComp.SR.tcNamespaceCannotContainValues(), vspec.RangeOfId)) | Parent p -> p let containerInfo = ModuleOrNamespaceContainerInfo parentModule let idvs, _ = TcAndPublishValSpec (cenv, env, containerInfo, ModuleOrMemberBinding, None, emptyUnscopedTyparEnv, vspec) @@ -5197,7 +5197,7 @@ and TcSignatureElementsMutRec cenv parent typeNames m mutRecNSInfo envInitial (d decls, (false, false) | SynModuleSigDecl.Val (vspec, _) -> - if isNamespace then error(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(), vspec.RangeOfId)) + if isNamespace then error(Error(FSComp.SR.tcNamespaceCannotContainValues(), vspec.RangeOfId)) let decls = [ MutRecShape.Lets vspec ] decls, (false, false) @@ -5281,9 +5281,9 @@ let CheckLetOrDoInNamespace binds m = | [ SynBinding (None, (SynBindingKind.StandaloneExpression | SynBindingKind.Do), false, false, [], _, _, _, None, (SynExpr.Do (SynExpr.Const (SynConst.Unit, _), _) | SynExpr.Const (SynConst.Unit, _)), _, _) ] -> () | [] -> - error(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(), m)) + error(Error(FSComp.SR.tcNamespaceCannotContainValues(), m)) | _ -> - error(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(), binds.Head.RangeOfHeadPattern)) + error(Error(FSComp.SR.tcNamespaceCannotContainValues(), binds.Head.RangeOfHeadPattern)) /// The non-mutually recursive case for a declaration let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem env synDecl = diff --git a/src/fsharp/CheckExpressions.fs b/src/fsharp/CheckExpressions.fs index 9136ea7bfe4..2bd59220802 100644 --- a/src/fsharp/CheckExpressions.fs +++ b/src/fsharp/CheckExpressions.fs @@ -1200,7 +1200,7 @@ let PublishValueDefn cenv env declKind (vspec: Val) = if (declKind = ModuleOrMemberBinding) && ((GetCurrAccumulatedModuleOrNamespaceType env).ModuleOrNamespaceKind = Namespace) && (Option.isNone vspec.MemberInfo) then - errorR(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(), vspec.Range)) + errorR(Error(FSComp.SR.tcNamespaceCannotContainValues(), vspec.Range)) if (declKind = ExtrinsicExtensionBinding) && ((GetCurrAccumulatedModuleOrNamespaceType env).ModuleOrNamespaceKind = Namespace) then diff --git a/src/fsharp/CompilerDiagnostics.fs b/src/fsharp/CompilerDiagnostics.fs index 04cf3858be1..4e8fffc493d 100644 --- a/src/fsharp/CompilerDiagnostics.fs +++ b/src/fsharp/CompilerDiagnostics.fs @@ -128,7 +128,6 @@ let GetRangeOfDiagnostic(err: PhasedDiagnostic) = | LetRecEvaluatedOutOfOrder (_, _, _, m) | Error (_, m) | ErrorWithSuggestions (_, m, _, _) - | NumberedError (_, m) | SyntaxError (_, m) | InternalError (_, m) | InterfaceNotRevealed(_, _, m) @@ -346,7 +345,6 @@ let GetDiagnosticNumber(err: PhasedDiagnostic) = | Error ((n, _), _) -> n | ErrorWithSuggestions ((n, _), _, _, _) -> n | Failure _ -> 192 - | NumberedError((n, _), _) -> n | IllegalFileNameChar(fileName, invalidChar) -> fst (FSComp.SR.buildUnexpectedFileNameCharacter(fileName, string invalidChar)) #if !NO_EXTENSIONTYPING | :? TypeProviderError as e -> e.Number @@ -362,9 +360,8 @@ let GetWarningLevel err = | LetRecEvaluatedOutOfOrder _ | DefensiveCopyWarning _ -> 5 - | NumberedError((n, _), _) - | ErrorWithSuggestions((n, _), _, _, _) - | Error((n, _), _) -> + | Error((n, _), _) + | ErrorWithSuggestions((n, _), _, _, _) -> // 1178, tcNoComparisonNeeded1, "The struct, record or union type '%s' is not structurally comparable because the type parameter %s does not satisfy the 'comparison' constraint..." // 1178, tcNoComparisonNeeded2, "The struct, record or union type '%s' is not structurally comparable because the type '%s' does not satisfy the 'comparison' constraint...." // 1178, tcNoEqualityNeeded1, "The struct, record or union type '%s' does not support structural equality because the type parameter %s does not satisfy the 'equality' constraint..." @@ -1452,8 +1449,6 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) (canSuggestNa os.Append(DecompileOpName s) |> ignore suggestNames suggestionF idText - | NumberedError ((_, s), _) -> os.Append s |> ignore - | InternalError (s, _) | InvalidArgument s @@ -1712,11 +1707,11 @@ type DiagnosticDetailedInfo = [] type Diagnostic = - | Short of bool * string - | Long of bool * DiagnosticDetailedInfo + | Short of FSharpDiagnosticSeverity * string + | Long of FSharpDiagnosticSeverity * DiagnosticDetailedInfo /// returns sequence that contains Diagnostic for the given error + Diagnostic for all related errors -let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, isError, err: PhasedDiagnostic, suggestNames: bool) = +let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, severity: FSharpDiagnosticSeverity, err: PhasedDiagnostic, suggestNames: bool) = let outputWhere (showFullPaths, errorStyle) m: DiagnosticLocation = if Range.equals m rangeStartup || Range.equals m rangeCmdArgs then { Range = m; TextRepresentation = ""; IsEmpty = true; File = "" } @@ -1777,11 +1772,17 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt | None -> None let OutputCanonicalInformation(subcategory, errorNumber) : DiagnosticCanonicalInformation = + let message = + match severity with + | FSharpDiagnosticSeverity.Error -> "error" + | FSharpDiagnosticSeverity.Warning -> "warning" + | FSharpDiagnosticSeverity.Info + | FSharpDiagnosticSeverity.Hidden -> "info" let text = match errorStyle with // Show the subcategory for --vserrors so that we can fish it out in Visual Studio and use it to determine error stickiness. - | ErrorStyle.VSErrors -> sprintf "%s %s FS%04d: " subcategory (if isError then "error" else "warning") errorNumber - | _ -> sprintf "%s FS%04d: " (if isError then "error" else "warning") errorNumber + | ErrorStyle.VSErrors -> sprintf "%s %s FS%04d: " subcategory message errorNumber + | _ -> sprintf "%s FS%04d: " message errorNumber { ErrorNumber = errorNumber; Subcategory = subcategory; TextRepresentation = text} let mainError, relatedErrors = SplitRelatedDiagnostics err @@ -1794,7 +1795,7 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt let entry: DiagnosticDetailedInfo = { Location = where; Canonical = canonical; Message = message } - errors.Add ( Diagnostic.Long(isError, entry ) ) + errors.Add ( Diagnostic.Long(severity, entry ) ) let OutputRelatedError(err: PhasedDiagnostic) = match errorStyle with @@ -1808,12 +1809,12 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt os.ToString() let entry: DiagnosticDetailedInfo = { Location = relWhere; Canonical = relCanonical; Message = relMessage} - errors.Add( Diagnostic.Long (isError, entry) ) + errors.Add( Diagnostic.Long (severity, entry) ) | _ -> let os = System.Text.StringBuilder() OutputPhasedDiagnostic os err flattenErrors suggestNames - errors.Add( Diagnostic.Short(isError, os.ToString()) ) + errors.Add( Diagnostic.Short(severity, os.ToString()) ) relatedErrors |> List.iter OutputRelatedError @@ -1831,10 +1832,10 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt /// used by fsc.exe and fsi.exe, but not by VS /// prints error and related errors to the specified StringBuilder -let rec OutputDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, isError) os (err: PhasedDiagnostic) = +let rec OutputDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, severity) os (err: PhasedDiagnostic) = // 'true' for "canSuggestNames" is passed last here because we want to report suggestions in fsc.exe and fsi.exe, just not in regular IDE usage. - let errors = CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, isError, err, true) + let errors = CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, severity, err, true) for e in errors do Printf.bprintf os "\n" match e with @@ -1886,9 +1887,9 @@ let ReportWarningAsError options err = type ErrorLoggerFilteringByScopedPragmas (checkFile, scopedPragmas, errorLogger: ErrorLogger) = inherit ErrorLogger("ErrorLoggerFilteringByScopedPragmas") - override x.DiagnosticSink (phasedError, isError) = - if isError then - errorLogger.DiagnosticSink (phasedError, isError) + override x.DiagnosticSink (phasedError, severity) = + if severity = FSharpDiagnosticSeverity.Error then + errorLogger.DiagnosticSink (phasedError, severity) else let report = let warningNum = GetDiagnosticNumber phasedError @@ -1901,7 +1902,7 @@ type ErrorLoggerFilteringByScopedPragmas (checkFile, scopedPragmas, errorLogger: (not checkFile || m.FileIndex = pragmaRange.FileIndex) && Position.posGeq m.Start pragmaRange.Start)) | None -> true - if report then errorLogger.DiagnosticSink(phasedError, false) + if report then errorLogger.DiagnosticSink(phasedError, severity) override x.ErrorCount = errorLogger.ErrorCount diff --git a/src/fsharp/CompilerDiagnostics.fsi b/src/fsharp/CompilerDiagnostics.fsi index bc60b6c6ad8..3eb231abf97 100644 --- a/src/fsharp/CompilerDiagnostics.fsi +++ b/src/fsharp/CompilerDiagnostics.fsi @@ -60,7 +60,7 @@ val SplitRelatedDiagnostics: PhasedDiagnostic -> PhasedDiagnostic * PhasedDiagno val OutputPhasedDiagnostic: StringBuilder -> PhasedDiagnostic -> flattenErrors: bool -> suggestNames: bool -> unit /// Output an error or warning to a buffer -val OutputDiagnostic: implicitIncludeDir:string * showFullPaths: bool * flattenErrors: bool * errorStyle: ErrorStyle * isError:bool -> StringBuilder -> PhasedDiagnostic -> unit +val OutputDiagnostic: implicitIncludeDir:string * showFullPaths: bool * flattenErrors: bool * errorStyle: ErrorStyle * severity: FSharpDiagnosticSeverity -> StringBuilder -> PhasedDiagnostic -> unit /// Output extra context information for an error or warning to a buffer val OutputDiagnosticContext: prefix:string -> fileLineFunction:(string -> int -> string) -> StringBuilder -> PhasedDiagnostic -> unit @@ -90,11 +90,11 @@ type DiagnosticDetailedInfo = /// Part of LegacyHostedCompilerForTesting [] type Diagnostic = - | Short of bool * string - | Long of bool * DiagnosticDetailedInfo + | Short of FSharpDiagnosticSeverity * string + | Long of FSharpDiagnosticSeverity * DiagnosticDetailedInfo /// Part of LegacyHostedCompilerForTesting -val CollectDiagnostic: implicitIncludeDir:string * showFullPaths: bool * flattenErrors: bool * errorStyle: ErrorStyle * isError:bool * PhasedDiagnostic * suggestNames: bool -> seq +val CollectDiagnostic: implicitIncludeDir:string * showFullPaths: bool * flattenErrors: bool * errorStyle: ErrorStyle * severity: FSharpDiagnosticSeverity * PhasedDiagnostic * suggestNames: bool -> seq /// Get an error logger that filters the reporting of warnings based on scoped pragma information val GetErrorLoggerFilteringByScopedPragmas: checkFile:bool * ScopedPragma list * ErrorLogger -> ErrorLogger diff --git a/src/fsharp/CompilerImports.fs b/src/fsharp/CompilerImports.fs index 70fca6f6f6d..8ebf45e3162 100644 --- a/src/fsharp/CompilerImports.fs +++ b/src/fsharp/CompilerImports.fs @@ -130,8 +130,46 @@ let WriteOptimizationData (tcGlobals, filename, inMem, ccu: CcuThunk, modulInfo) let rName = if ccu.AssemblyName = getFSharpCoreLibraryName then FSharpOptimizationDataResourceName2 else FSharpOptimizationDataResourceName PickleToResource inMem filename tcGlobals ccu (rName+ccu.AssemblyName) Optimizer.p_CcuOptimizationInfo modulInfo +let EncodeSignatureData(tcConfig: TcConfig, tcGlobals, exportRemapping, generatedCcu, outfile, isIncrementalBuild) = + if tcConfig.GenerateSignatureData then + let resource = WriteSignatureData (tcConfig, tcGlobals, exportRemapping, generatedCcu, outfile, isIncrementalBuild) + // The resource gets written to a file for FSharp.Core + let useDataFiles = (tcConfig.useOptimizationDataFile || tcGlobals.compilingFslib) && not isIncrementalBuild + if useDataFiles then + let sigDataFileName = (Filename.chopExtension outfile)+".sigdata" + let bytes = resource.GetBytes() + use fileStream = File.Create(sigDataFileName, bytes.Length) + bytes.CopyTo fileStream + let resources = + [ resource ] + let sigAttr = mkSignatureDataVersionAttr tcGlobals (parseILVersion Internal.Utilities.FSharpEnvironment.FSharpBinaryMetadataFormatRevision) + [sigAttr], resources + else + [], [] + +let EncodeOptimizationData(tcGlobals, tcConfig: TcConfig, outfile, exportRemapping, data, isIncrementalBuild) = + if tcConfig.GenerateOptimizationData then + let data = map2Of2 (Optimizer.RemapOptimizationInfo tcGlobals exportRemapping) data + // As with the sigdata file, the optdata gets written to a file for FSharp.Core + let useDataFiles = (tcConfig.useOptimizationDataFile || tcGlobals.compilingFslib) && not isIncrementalBuild + if useDataFiles then + let ccu, modulInfo = data + let bytes = TypedTreePickle.pickleObjWithDanglingCcus isIncrementalBuild outfile tcGlobals ccu Optimizer.p_CcuOptimizationInfo modulInfo + let optDataFileName = (Filename.chopExtension outfile)+".optdata" + File.WriteAllBytes(optDataFileName, bytes) + let (ccu, optData) = + if tcConfig.onlyEssentialOptimizationData then + map2Of2 Optimizer.AbstractOptimizationInfoToEssentials data + else + data + [ WriteOptimizationData (tcGlobals, outfile, isIncrementalBuild, ccu, optData) ] + else + [ ] + exception AssemblyNotResolved of (*originalName*) string * range + exception MSBuildReferenceResolutionWarning of (*MSBuild warning code*)string * (*Message*)string * range + exception MSBuildReferenceResolutionError of (*MSBuild warning code*)string * (*Message*)string * range let OpenILBinary(filename, reduceMemoryUsage, pdbDirPath, shadowCopyReferences, tryGetMetadataSnapshot) = diff --git a/src/fsharp/CompilerImports.fsi b/src/fsharp/CompilerImports.fsi index adcb466a5bf..41687660eb4 100644 --- a/src/fsharp/CompilerImports.fsi +++ b/src/fsharp/CompilerImports.fsi @@ -12,6 +12,7 @@ open FSharp.Compiler.CheckExpressions open FSharp.Compiler.CompilerConfig open FSharp.Compiler.DependencyManager open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Optimizer open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TcGlobals @@ -42,11 +43,24 @@ val IsReflectedDefinitionsResource: ILResource -> bool val GetSignatureDataResourceName: ILResource -> string -/// Write F# signature data as an IL resource -val WriteSignatureData: TcConfig * TcGlobals * Remap * CcuThunk * filename: string * inMem: bool -> ILResource - -/// Write F# optimization data as an IL resource -val WriteOptimizationData: TcGlobals * filename: string * inMem: bool * CcuThunk * Optimizer.LazyModuleInfo -> ILResource +/// Encode the F# interface data into a set of IL attributes and resources +val EncodeSignatureData: + tcConfig:TcConfig * + tcGlobals:TcGlobals * + exportRemapping:Remap * + generatedCcu: CcuThunk * + outfile: string * + isIncrementalBuild: bool + -> ILAttribute list * ILResource list + +val EncodeOptimizationData: + tcGlobals:TcGlobals * + tcConfig:TcConfig * + outfile: string * + exportRemapping:Remap * + (CcuThunk * #CcuOptimizationInfo) * + isIncrementalBuild: bool + -> ILResource list [] type ResolveAssemblyReferenceMode = diff --git a/src/fsharp/CompilerOptions.fs b/src/fsharp/CompilerOptions.fs index 41fb657d69b..9262b958825 100644 --- a/src/fsharp/CompilerOptions.fs +++ b/src/fsharp/CompilerOptions.fs @@ -1717,11 +1717,16 @@ let DoWithColor newColor f = finally ignoreFailureOnMono1_1_16 (fun () -> Console.ForegroundColor <- c) -let DoWithErrorColor isError f = +let DoWithDiagnosticColor severity f = match foreBackColor() with | None -> f() | Some (_, backColor) -> + let infoColor = if backColor = ConsoleColor.White then ConsoleColor.Blue else ConsoleColor.Green let warnColor = if backColor = ConsoleColor.White then ConsoleColor.DarkBlue else ConsoleColor.Cyan let errorColor = ConsoleColor.Red - let color = if isError then errorColor else warnColor + let color = + match severity with + | FSharpDiagnosticSeverity.Error -> errorColor + | FSharpDiagnosticSeverity.Warning -> warnColor + | _ -> infoColor DoWithColor color f diff --git a/src/fsharp/CompilerOptions.fsi b/src/fsharp/CompilerOptions.fsi index 2b1c1d9e2be..2b5393a27d5 100644 --- a/src/fsharp/CompilerOptions.fsi +++ b/src/fsharp/CompilerOptions.fsi @@ -5,6 +5,7 @@ module internal FSharp.Compiler.CompilerOptions open System open FSharp.Compiler.CompilerConfig +open FSharp.Compiler.Diagnostics // For command-line options that can be suffixed with +/- [] @@ -38,48 +39,48 @@ and CompilerOptionBlock = | PublicOptions of string * CompilerOption list | PrivateOptions of CompilerOption list -val PrintCompilerOptionBlocks : CompilerOptionBlock list -> unit // for printing usage +val PrintCompilerOptionBlocks: CompilerOptionBlock list -> unit // for printing usage -val DumpCompilerOptionBlocks : CompilerOptionBlock list -> unit // for QA +val DumpCompilerOptionBlocks: CompilerOptionBlock list -> unit // for QA -val FilterCompilerOptionBlock : (CompilerOption -> bool) -> CompilerOptionBlock -> CompilerOptionBlock +val FilterCompilerOptionBlock: (CompilerOption -> bool) -> CompilerOptionBlock -> CompilerOptionBlock /// Parse and process a set of compiler options -val ParseCompilerOptions : (string -> unit) * CompilerOptionBlock list * string list -> unit +val ParseCompilerOptions: (string -> unit) * CompilerOptionBlock list * string list -> unit -val DisplayBannerText : TcConfigBuilder -> unit +val DisplayBannerText: TcConfigBuilder -> unit -val GetCoreFscCompilerOptions : TcConfigBuilder -> CompilerOptionBlock list +val GetCoreFscCompilerOptions: TcConfigBuilder -> CompilerOptionBlock list -val GetCoreFsiCompilerOptions : TcConfigBuilder -> CompilerOptionBlock list +val GetCoreFsiCompilerOptions: TcConfigBuilder -> CompilerOptionBlock list -val GetCoreServiceCompilerOptions : TcConfigBuilder -> CompilerOptionBlock list +val GetCoreServiceCompilerOptions: TcConfigBuilder -> CompilerOptionBlock list /// Apply args to TcConfigBuilder and return new list of source files val ApplyCommandLineArgs: tcConfigB: TcConfigBuilder * sourceFiles: string list * argv: string list -> string list // Expose the "setters" for some user switches, to enable setting of defaults -val SetOptimizeSwitch : TcConfigBuilder -> OptionSwitch -> unit +val SetOptimizeSwitch: TcConfigBuilder -> OptionSwitch -> unit -val SetTailcallSwitch : TcConfigBuilder -> OptionSwitch -> unit +val SetTailcallSwitch: TcConfigBuilder -> OptionSwitch -> unit -val SetDebugSwitch : TcConfigBuilder -> string option -> OptionSwitch -> unit +val SetDebugSwitch: TcConfigBuilder -> string option -> OptionSwitch -> unit -val PrintOptionInfo : TcConfigBuilder -> unit +val PrintOptionInfo: TcConfigBuilder -> unit -val SetTargetProfile : TcConfigBuilder -> string -> unit +val SetTargetProfile: TcConfigBuilder -> string -> unit // Miscellany -val ignoreFailureOnMono1_1_16 : (unit -> unit) -> unit +val ignoreFailureOnMono1_1_16: (unit -> unit) -> unit -val mutable enableConsoleColoring : bool +val mutable enableConsoleColoring: bool -val DoWithColor : ConsoleColor -> (unit -> 'a) -> 'a +val DoWithColor: ConsoleColor -> (unit -> 'a) -> 'a -val DoWithErrorColor : bool -> (unit -> 'a) -> 'a +val DoWithDiagnosticColor: FSharpDiagnosticSeverity -> (unit -> 'a) -> 'a -val ReportTime : TcConfig -> string -> unit +val ReportTime: TcConfig -> string -> unit -val GetAbbrevFlagSet : TcConfigBuilder -> bool -> Set +val GetAbbrevFlagSet: TcConfigBuilder -> bool -> Set -val PostProcessCompilerArgs : string Set -> string [] -> string list +val PostProcessCompilerArgs: string Set -> string [] -> string list diff --git a/src/fsharp/Diagnostics.fs b/src/fsharp/Diagnostics.fs index 62fbc310a0f..350703012ed 100644 --- a/src/fsharp/Diagnostics.fs +++ b/src/fsharp/Diagnostics.fs @@ -5,7 +5,14 @@ // F# compiler. namespace FSharp.Compiler.Diagnostics -type public FSharpDiagnosticOptions = +[] +type FSharpDiagnosticSeverity = + | Hidden + | Info + | Warning + | Error + +type FSharpDiagnosticOptions = { WarnLevel: int GlobalWarnAsError: bool diff --git a/src/fsharp/Diagnostics.fsi b/src/fsharp/Diagnostics.fsi index dc112138146..b1dc86be20b 100644 --- a/src/fsharp/Diagnostics.fsi +++ b/src/fsharp/Diagnostics.fsi @@ -6,6 +6,13 @@ namespace FSharp.Compiler.Diagnostics +[] +type FSharpDiagnosticSeverity = + | Hidden + | Info + | Warning + | Error + type FSharpDiagnosticOptions = { WarnLevel: int GlobalWarnAsError: bool diff --git a/src/fsharp/ErrorLogger.fs b/src/fsharp/ErrorLogger.fs index f73c3f9ca95..c2dc29eb27c 100644 --- a/src/fsharp/ErrorLogger.fs +++ b/src/fsharp/ErrorLogger.fs @@ -2,6 +2,7 @@ module FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Diagnostics open FSharp.Compiler.Features open FSharp.Compiler.Text.Range open FSharp.Compiler.Text @@ -62,19 +63,12 @@ let (|StopProcessing|_|) exn = match exn with StopProcessingExn _ -> Some () | _ let StopProcessing<'T> = StopProcessingExn None -exception NumberedError of (int * string) * range with // int is e.g. 191 in FS0191 - override this.Message = - match this :> exn with - | NumberedError((_, msg), _) -> msg - | _ -> "impossible" - -exception Error of (int * string) * range with // int is e.g. 191 in FS0191 // eventually remove this type, it is a transitional artifact of the old unnumbered error style +exception Error of (int * string) * range with // int is e.g. 191 in FS0191 override this.Message = match this :> exn with | Error((_, msg), _) -> msg | _ -> "impossible" - exception InternalError of msg: string * range with override this.Message = match this :> exn with @@ -274,18 +268,18 @@ type ErrorLogger(nameForDebugging:string) = abstract ErrorCount: int // The 'Impl' factoring enables a developer to place a breakpoint at the non-Impl // code just below and get a breakpoint for all error logger implementations. - abstract DiagnosticSink: phasedError: PhasedDiagnostic * isError: bool -> unit + abstract DiagnosticSink: phasedError: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit member _.DebugDisplay() = sprintf "ErrorLogger(%s)" nameForDebugging let DiscardErrorsLogger = { new ErrorLogger("DiscardErrorsLogger") with - member x.DiagnosticSink(phasedError, isError) = () + member x.DiagnosticSink(phasedError, severity) = () member x.ErrorCount = 0 } let AssertFalseErrorLogger = { new ErrorLogger("AssertFalseErrorLogger") with // TODO: reenable these asserts in the compiler service - member x.DiagnosticSink(phasedError, isError) = (* assert false; *) () + member x.DiagnosticSink(phasedError, severity) = (* assert false; *) () member x.ErrorCount = (* assert false; *) 0 } @@ -293,17 +287,20 @@ type CapturingErrorLogger(nm) = inherit ErrorLogger(nm) let mutable errorCount = 0 let diagnostics = ResizeArray() - override x.DiagnosticSink(phasedError, isError) = - if isError then errorCount <- errorCount + 1 - diagnostics.Add (phasedError, isError) - override x.ErrorCount = errorCount - member x.Diagnostics = diagnostics |> Seq.toList - member x.CommitDelayedDiagnostics(errorLogger:ErrorLogger) = + + override _.DiagnosticSink(phasedError, severity) = + if severity = FSharpDiagnosticSeverity.Error then errorCount <- errorCount + 1 + diagnostics.Add (phasedError, severity) + + override _.ErrorCount = errorCount + + member _.Diagnostics = diagnostics |> Seq.toList + + member _.CommitDelayedDiagnostics(errorLogger:ErrorLogger) = // Eagerly grab all the errors and warnings from the mutable collection let errors = diagnostics.ToArray() errors |> Array.iter errorLogger.DiagnosticSink - /// Type holds thread-static globals for use by the compile. type internal CompileThreadStatic = [] @@ -312,7 +309,8 @@ type internal CompileThreadStatic = [] static val mutable private errorLogger : ErrorLogger - static member BuildPhaseUnchecked with get() = CompileThreadStatic.buildPhase (* This can be a null value *) + static member BuildPhaseUnchecked = CompileThreadStatic.buildPhase (* This can be a null value *) + static member BuildPhase with get() = match box CompileThreadStatic.buildPhase with @@ -368,7 +366,7 @@ module ErrorLoggerExtensions = type ErrorLogger with - member x.ErrorR exn = + member x.EmitDiagnostic (exn, severity) = match exn with | InternalError (s, _) | Failure s as exn -> System.Diagnostics.Debug.Assert(false, sprintf "Unexpected exception raised in compiler: %s\n%s" s (exn.ToString())) @@ -379,22 +377,20 @@ module ErrorLoggerExtensions = | ReportedError _ -> PreserveStackTrace exn raise exn - | _ -> x.DiagnosticSink(PhasedDiagnostic.Create(exn, CompileThreadStatic.BuildPhase), true) + | _ -> x.DiagnosticSink(PhasedDiagnostic.Create(exn, CompileThreadStatic.BuildPhase), severity) + + member x.ErrorR exn = + x.EmitDiagnostic (exn, FSharpDiagnosticSeverity.Error) member x.Warning exn = - match exn with - | StopProcessing - | ReportedError _ -> - PreserveStackTrace exn - raise exn - | _ -> x.DiagnosticSink(PhasedDiagnostic.Create(exn, CompileThreadStatic.BuildPhase), false) + x.EmitDiagnostic (exn, FSharpDiagnosticSeverity.Warning) member x.Error exn = x.ErrorR exn raise (ReportedError (Some exn)) - member x.SimulateError (ph: PhasedDiagnostic) = - x.DiagnosticSink (ph, true) + member x.SimulateError (ph: PhasedDiagnostic) = + x.DiagnosticSink (ph, FSharpDiagnosticSeverity.Error) raise (ReportedError (Some ph.Exception)) member x.ErrorRecovery (exn: exn) (m: range) = @@ -475,11 +471,11 @@ let error exn = CompileThreadStatic.ErrorLogger.Error exn /// Simulates an error. For test purposes only. let simulateError (p : PhasedDiagnostic) = CompileThreadStatic.ErrorLogger.SimulateError p -let diagnosticSink (phasedError, isError) = CompileThreadStatic.ErrorLogger.DiagnosticSink (phasedError, isError) +let diagnosticSink (phasedError, severity) = CompileThreadStatic.ErrorLogger.DiagnosticSink (phasedError, severity) -let errorSink pe = diagnosticSink (pe, true) +let errorSink pe = diagnosticSink (pe, FSharpDiagnosticSeverity.Error) -let warnSink pe = diagnosticSink (pe, false) +let warnSink pe = diagnosticSink (pe, FSharpDiagnosticSeverity.Warning) let errorRecovery exn m = CompileThreadStatic.ErrorLogger.ErrorRecovery exn m diff --git a/src/fsharp/ErrorLogger.fsi b/src/fsharp/ErrorLogger.fsi index ec2e9340635..a1e933fd9f0 100644 --- a/src/fsharp/ErrorLogger.fsi +++ b/src/fsharp/ErrorLogger.fsi @@ -3,6 +3,7 @@ module internal FSharp.Compiler.ErrorLogger open System +open FSharp.Compiler.Diagnostics open FSharp.Compiler.Features open FSharp.Compiler.Text @@ -40,8 +41,6 @@ val ( |StopProcessing|_| ): exn:exn -> unit option val StopProcessing<'T> : exn -exception NumberedError of (int * string) * range - exception Error of (int * string) * range exception InternalError of msg: string * range @@ -139,7 +138,7 @@ type ErrorLogger = member DebugDisplay: unit -> string - abstract member DiagnosticSink: phasedError:PhasedDiagnostic * isError:bool -> unit + abstract member DiagnosticSink: phasedError:PhasedDiagnostic * severity:FSharpDiagnosticSeverity -> unit abstract member ErrorCount: int @@ -154,9 +153,9 @@ type CapturingErrorLogger = member CommitDelayedDiagnostics: errorLogger:ErrorLogger -> unit - override DiagnosticSink: phasedError:PhasedDiagnostic * isError:bool -> unit + override DiagnosticSink: phasedError:PhasedDiagnostic * severity:FSharpDiagnosticSeverity -> unit - member Diagnostics: (PhasedDiagnostic * bool) list + member Diagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list override ErrorCount: int @@ -207,7 +206,7 @@ val error: exn:exn -> 'a val simulateError: p:PhasedDiagnostic -> 'a -val diagnosticSink: phasedError:PhasedDiagnostic * isError:bool -> unit +val diagnosticSink: phasedError:PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit val errorSink: pe:PhasedDiagnostic -> unit diff --git a/src/fsharp/ExtensionTyping.fs b/src/fsharp/ExtensionTyping.fs index 5409fda0ab9..c3a0e38f952 100644 --- a/src/fsharp/ExtensionTyping.fs +++ b/src/fsharp/ExtensionTyping.fs @@ -171,7 +171,7 @@ module internal ExtensionTyping = () ] with :? TypeProviderError as tpe -> - tpe.Iter(fun e -> errorR(NumberedError((e.Number, e.ContextualErrorMessage), m)) ) + tpe.Iter(fun e -> errorR(Error((e.Number, e.ContextualErrorMessage), m)) ) [] let providers = Tainted<_>.CreateAll(providerSpecs) diff --git a/src/fsharp/LegacyHostedCompilerForTesting.fs b/src/fsharp/LegacyHostedCompilerForTesting.fs index ced4f14db2a..480eb2612d1 100644 --- a/src/fsharp/LegacyHostedCompilerForTesting.fs +++ b/src/fsharp/LegacyHostedCompilerForTesting.fs @@ -8,6 +8,7 @@ namespace FSharp.Compiler.CodeAnalysis.Hosted open System open System.IO open System.Text.RegularExpressions +open FSharp.Compiler.Diagnostics open FSharp.Compiler.Driver open FSharp.Compiler.ErrorLogger open FSharp.Compiler.CompilerConfig @@ -90,16 +91,16 @@ type internal FscCompiler(legacyReferenceResolver) = /// converts short and long issue types to the same CompilationIssue representation let convert issue : CompilationIssue = match issue with - | Diagnostic.Short(isError, text) -> + | Diagnostic.Short(severity, text) -> { Location = emptyLocation Code = "" Subcategory = "" File = "" Text = text - Type = if isError then CompilationIssueType.Error else CompilationIssueType.Warning + Type = if (severity = FSharpDiagnosticSeverity.Error) then CompilationIssueType.Error else CompilationIssueType.Warning } - | Diagnostic.Long(isError, details) -> + | Diagnostic.Long(severity, details) -> let loc, file = match details.Location with | Some l when not l.IsEmpty -> @@ -116,7 +117,7 @@ type internal FscCompiler(legacyReferenceResolver) = Subcategory = details.Canonical.Subcategory File = file Text = details.Message - Type = if isError then CompilationIssueType.Error else CompilationIssueType.Warning + Type = if (severity = FSharpDiagnosticSeverity.Error) then CompilationIssueType.Error else CompilationIssueType.Warning } /// test if --test:ErrorRanges flag is set diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index a132e7c5c2d..07bd84c44f5 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -1693,7 +1693,7 @@ module ProvidedMethodCalls = | true, v -> v | _ -> let typeProviderDesignation = ExtensionTyping.DisplayNameOfTypeProvider (pe.TypeProvider, m) - error(NumberedError(FSComp.SR.etIncorrectParameterExpression(typeProviderDesignation, vRaw.Name), m)) + error(Error(FSComp.SR.etIncorrectParameterExpression(typeProviderDesignation, vRaw.Name), m)) and exprToExpr expr = let _, (resExpr, _) = exprToExprAndWitness false expr diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index 35b33ca82a5..a0667246250 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -320,6 +320,31 @@ let ReportParsingStatistics res = | ParsedInput.ImplFile (ParsedImplFileInput (modules = impls)) -> printfn "parsing yielded %d definitions" (List.collect flattenModImpl impls).Length +let EmptyParsedInput(filename, isLastCompiland) = + let lower = String.lowercase filename + if FSharpSigFileSuffixes |> List.exists (Filename.checkSuffix lower) then + ParsedInput.SigFile( + ParsedSigFileInput( + filename, + QualFileNameOfImpls filename [], + [], + [], + [] + ) + ) + else + ParsedInput.ImplFile( + ParsedImplFileInput( + filename, + false, + QualFileNameOfImpls filename [], + [], + [], + [], + isLastCompiland + ) + ) + /// Parse an input, drawing tokens from the LexBuffer let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, conditionalCompilationDefines, lexbuf, filename, isLastCompiland, errorLogger) = use unwindbuildphase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse @@ -360,11 +385,11 @@ let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, conditionalComp res ) - Some input + input with e -> errorRecovery e rangeStartup - None + EmptyParsedInput(filename, isLastCompiland) let ValidSuffixes = FSharpSigFileSuffixes@FSharpImplFileSuffixes @@ -391,7 +416,7 @@ let ParseOneInputFile (tcConfig: TcConfig, lexResourceManager, conditionalCompil with e -> errorRecovery e rangeStartup - None + EmptyParsedInput(filename, isLastCompiland) let ProcessMetaCommandsFromInput (nowarnF: 'state -> range * string -> 'state, @@ -430,18 +455,18 @@ let ProcessMetaCommandsFromInput try match hash with | ParsedHashDirective("I", args, m) -> - if not canHaveScriptMetaCommands then - errorR(HashIncludeNotAllowedInNonScript m) - match args with - | [path] -> - matchedm <- m - tcConfig.AddIncludePath(m, path, pathOfMetaCommandSource) - state - | _ -> - errorR(Error(FSComp.SR.buildInvalidHashIDirective(), m)) - state + if not canHaveScriptMetaCommands then + errorR(HashIncludeNotAllowedInNonScript m) + match args with + | [path] -> + matchedm <- m + tcConfig.AddIncludePath(m, path, pathOfMetaCommandSource) + state + | _ -> + errorR(Error(FSComp.SR.buildInvalidHashIDirective(), m)) + state | ParsedHashDirective("nowarn",numbers,m) -> - List.fold (fun state d -> nowarnF state (m,d)) state numbers + List.fold (fun state d -> nowarnF state (m,d)) state numbers | ParsedHashDirective(("reference" | "r"), args, m) -> matchedm<-m @@ -452,31 +477,31 @@ let ProcessMetaCommandsFromInput ProcessDependencyManagerDirective Directive.Include args m state | ParsedHashDirective("load", args, m) -> - if not canHaveScriptMetaCommands then - errorR(HashDirectiveNotAllowedInNonScript m) - match args with - | _ :: _ -> - matchedm<-m - args |> List.iter (fun path -> loadSourceF state (m, path)) - | _ -> - errorR(Error(FSComp.SR.buildInvalidHashloadDirective(), m)) - state + if not canHaveScriptMetaCommands then + errorR(HashDirectiveNotAllowedInNonScript m) + match args with + | _ :: _ -> + matchedm<-m + args |> List.iter (fun path -> loadSourceF state (m, path)) + | _ -> + errorR(Error(FSComp.SR.buildInvalidHashloadDirective(), m)) + state | ParsedHashDirective("time", args, m) -> - if not canHaveScriptMetaCommands then - errorR(HashDirectiveNotAllowedInNonScript m) - match args with - | [] -> - () - | ["on" | "off"] -> - () - | _ -> - errorR(Error(FSComp.SR.buildInvalidHashtimeDirective(), m)) - state + if not canHaveScriptMetaCommands then + errorR(HashDirectiveNotAllowedInNonScript m) + match args with + | [] -> + () + | ["on" | "off"] -> + () + | _ -> + errorR(Error(FSComp.SR.buildInvalidHashtimeDirective(), m)) + state | _ -> - (* warning(Error("This meta-command has been ignored", m)) *) - state + (* warning(Error("This meta-command has been ignored", m)) *) + state with e -> errorRecovery e matchedm; state let rec WarnOnIgnoredSpecDecls decls = diff --git a/src/fsharp/ParseAndCheckInputs.fsi b/src/fsharp/ParseAndCheckInputs.fsi index 21f20a056e6..fe74f7ede2b 100644 --- a/src/fsharp/ParseAndCheckInputs.fsi +++ b/src/fsharp/ParseAndCheckInputs.fsi @@ -47,7 +47,7 @@ val ApplyMetaCommandsFromInputToTcConfig: TcConfig * ParsedInput * string * Depe val ApplyNoWarnsToTcConfig: TcConfig * ParsedInput * string -> TcConfig /// Parse one input file -val ParseOneInputFile: TcConfig * Lexhelp.LexResourceManager * string list * string * isLastCompiland: (bool * bool) * ErrorLogger * (*retryLocked*) bool -> ParsedInput option +val ParseOneInputFile: TcConfig * Lexhelp.LexResourceManager * string list * string * isLastCompiland: (bool * bool) * ErrorLogger * retryLocked: bool -> ParsedInput /// Get the initial type checking environment including the loading of mscorlib/System.Core, FSharp.Core /// applying the InternalsVisibleTo in referenced assemblies and opening 'Checked' if requested. @@ -134,4 +134,9 @@ val ParseOneInputLexbuf: filename: string * isLastCompiland: (bool * bool) * errorLogger: ErrorLogger - -> ParsedInput option + -> ParsedInput + +val EmptyParsedInput: + filename: string * + isLastCompiland: (bool * bool) + -> ParsedInput diff --git a/src/fsharp/ScriptClosure.fs b/src/fsharp/ScriptClosure.fs index 52bfc807349..9003c455a19 100644 --- a/src/fsharp/ScriptClosure.fs +++ b/src/fsharp/ScriptClosure.fs @@ -15,6 +15,7 @@ open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.CompilerImports open FSharp.Compiler.DependencyManager +open FSharp.Compiler.Diagnostics open FSharp.Compiler.ErrorLogger open FSharp.Compiler.IO open FSharp.Compiler.CodeAnalysis @@ -27,8 +28,8 @@ open FSharp.Compiler.Text.Range type LoadClosureInput = { FileName: string SyntaxTree: ParsedInput option - ParseDiagnostics: (PhasedDiagnostic * bool) list - MetaCommandDiagnostics: (PhasedDiagnostic * bool) list } + ParseDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list + MetaCommandDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list } [] type LoadClosure = @@ -60,13 +61,13 @@ type LoadClosure = NoWarns: (string * range list) list /// Diagnostics seen while processing resolutions - ResolutionDiagnostics: (PhasedDiagnostic * bool) list + ResolutionDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list /// Diagnostics seen while parsing root of closure - AllRootFileDiagnostics: (PhasedDiagnostic * bool) list + AllRootFileDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list /// Diagnostics seen while processing the compiler options implied root of closure - LoadClosureRootFileDiagnostics: (PhasedDiagnostic * bool) list + LoadClosureRootFileDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list } @@ -82,7 +83,7 @@ module ScriptPreprocessClosure = type ClosureSource = ClosureSource of filename: string * referenceRange: range * sourceText: ISourceText * parseRequired: bool /// Represents an output of the closure finding process - type ClosureFile = ClosureFile of string * range * ParsedInput option * (PhasedDiagnostic * bool) list * (PhasedDiagnostic * bool) list * (string * range) list // filename, range, errors, warnings, nowarns + type ClosureFile = ClosureFile of string * range * ParsedInput option * (PhasedDiagnostic * FSharpDiagnosticSeverity) list * (PhasedDiagnostic * FSharpDiagnosticSeverity) list * (string * range) list // filename, range, errors, warnings, nowarns type Observed() = let seen = System.Collections.Generic.Dictionary<_, bool>() @@ -312,33 +313,28 @@ module ScriptPreprocessClosure = let result = ParseScriptText (filename, sourceText, tcConfig, codeContext, lexResourceManager, errorLogger) result, errorLogger.Diagnostics - match parseResult with - | Some parsedScriptAst -> - let errorLogger = CapturingErrorLogger("FindClosureMetaCommands") - use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) - let pathOfMetaCommandSource = Path.GetDirectoryName filename - let preSources = tcConfig.GetAvailableLoadedSources() + let errorLogger = CapturingErrorLogger("FindClosureMetaCommands") + use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) + let pathOfMetaCommandSource = Path.GetDirectoryName filename + let preSources = tcConfig.GetAvailableLoadedSources() - let tcConfigResult, noWarns = ApplyMetaCommandsFromInputToTcConfigAndGatherNoWarn (tcConfig, parsedScriptAst, pathOfMetaCommandSource, dependencyProvider) - tcConfig <- tcConfigResult // We accumulate the tcConfig in order to collect assembly references + let tcConfigResult, noWarns = ApplyMetaCommandsFromInputToTcConfigAndGatherNoWarn (tcConfig, parseResult, pathOfMetaCommandSource, dependencyProvider) + tcConfig <- tcConfigResult // We accumulate the tcConfig in order to collect assembly references - yield! resolveDependencyManagerSources filename + yield! resolveDependencyManagerSources filename - let postSources = tcConfig.GetAvailableLoadedSources() - let sources = if preSources.Length < postSources.Length then postSources.[preSources.Length..] else [] + let postSources = tcConfig.GetAvailableLoadedSources() + let sources = if preSources.Length < postSources.Length then postSources.[preSources.Length..] else [] - yield! resolveDependencyManagerSources filename - for (m, subFile) in sources do - if IsScript subFile then - for subSource in ClosureSourceOfFilename(subFile, m, tcConfigResult.inputCodePage, false) do - yield! loop subSource - else - yield ClosureFile(subFile, m, None, [], [], []) - yield ClosureFile(filename, m, Some parsedScriptAst, parseDiagnostics, errorLogger.Diagnostics, noWarns) + yield! resolveDependencyManagerSources filename + for (m, subFile) in sources do + if IsScript subFile then + for subSource in ClosureSourceOfFilename(subFile, m, tcConfigResult.inputCodePage, false) do + yield! loop subSource + else + yield ClosureFile(subFile, m, None, [], [], []) + yield ClosureFile(filename, m, Some parseResult, parseDiagnostics, errorLogger.Diagnostics, noWarns) - | None -> - printfn "yielding source %s (failed parse)" filename - yield ClosureFile(filename, m, None, parseDiagnostics, [], []) else // Don't traverse into .fs leafs. printfn "yielding non-script source %s" filename diff --git a/src/fsharp/ScriptClosure.fsi b/src/fsharp/ScriptClosure.fsi index 67d90654a27..f42c5f2be25 100644 --- a/src/fsharp/ScriptClosure.fsi +++ b/src/fsharp/ScriptClosure.fsi @@ -9,6 +9,7 @@ open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports open FSharp.Compiler.DependencyManager +open FSharp.Compiler.Diagnostics open FSharp.Compiler.ErrorLogger open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Syntax @@ -27,9 +28,9 @@ type LoadClosureInput = SyntaxTree: ParsedInput option - ParseDiagnostics: (PhasedDiagnostic * bool) list + ParseDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list - MetaCommandDiagnostics: (PhasedDiagnostic * bool) list + MetaCommandDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list } [] @@ -62,13 +63,13 @@ type LoadClosure = NoWarns: (string * range list) list /// Diagnostics seen while processing resolutions - ResolutionDiagnostics: (PhasedDiagnostic * bool) list + ResolutionDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list /// Diagnostics to show for root of closure (used by fsc.fs) - AllRootFileDiagnostics: (PhasedDiagnostic * bool) list + AllRootFileDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list /// Diagnostics seen while processing the compiler options implied root of closure - LoadClosureRootFileDiagnostics: (PhasedDiagnostic * bool) list } + LoadClosureRootFileDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list } /// Analyze a script text and find the closure of its references. /// Used from FCS, when editing a script file. diff --git a/src/fsharp/SyntaxTree.fs b/src/fsharp/SyntaxTree.fs index 165f9bfe911..e6b2e74784f 100644 --- a/src/fsharp/SyntaxTree.fs +++ b/src/fsharp/SyntaxTree.fs @@ -1864,6 +1864,11 @@ type ParsedInput = | SigFile of ParsedSigFileInput + member inp.FileName = + match inp with + | ParsedInput.ImplFile (ParsedImplFileInput (fileName=filename)) + | ParsedInput.SigFile (ParsedSigFileInput (fileName=filename)) -> filename + member inp.Range = match inp with | ParsedInput.ImplFile (ParsedImplFileInput (modules=SynModuleOrNamespace(range=m) :: _)) diff --git a/src/fsharp/SyntaxTree.fsi b/src/fsharp/SyntaxTree.fsi index ad9e4464f09..efe5bcf47c6 100644 --- a/src/fsharp/SyntaxTree.fsi +++ b/src/fsharp/SyntaxTree.fsi @@ -2106,5 +2106,8 @@ type ParsedInput = /// A parsed signature file | SigFile of ParsedSigFileInput + /// Gets the file name for the parsed input + member FileName: string + /// Gets the syntax range of this construct member Range: range diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 4803a5632dc..ec8a2720f33 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -39,6 +39,7 @@ open FSharp.Compiler.CompilerOptions open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.CreateILModule open FSharp.Compiler.DependencyManager +open FSharp.Compiler.Diagnostics open FSharp.Compiler.ErrorLogger open FSharp.Compiler.IlxGen open FSharp.Compiler.InfoReader @@ -69,20 +70,20 @@ type ErrorLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, nameFo let mutable errors = 0 /// Called when an error or warning occurs - abstract HandleIssue: tcConfigB: TcConfigBuilder * error: PhasedDiagnostic * isError: bool -> unit + abstract HandleIssue: tcConfigB: TcConfigBuilder * error: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit /// Called when 'too many errors' has occurred abstract HandleTooManyErrors: text: string -> unit override x.ErrorCount = errors - override x.DiagnosticSink(err, isError) = - if isError || ReportWarningAsError tcConfigB.errorSeverityOptions err then + override x.DiagnosticSink(err, severity) = + if severity = FSharpDiagnosticSeverity.Error || ReportWarningAsError tcConfigB.errorSeverityOptions err then if errors >= tcConfigB.maxErrors then x.HandleTooManyErrors(FSComp.SR.fscTooManyErrors()) exiter.Exit 1 - x.HandleIssue(tcConfigB, err, true) + x.HandleIssue(tcConfigB, err, severity) errors <- errors + 1 @@ -93,7 +94,7 @@ type ErrorLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, nameFo | _ -> () elif ReportWarning tcConfigB.errorSeverityOptions err then - x.HandleIssue(tcConfigB, err, isError) + x.HandleIssue(tcConfigB, err, severity) /// Create an error logger that counts and prints errors @@ -101,11 +102,11 @@ let ConsoleErrorLoggerUpToMaxErrors (tcConfigB: TcConfigBuilder, exiter : Exiter { new ErrorLoggerUpToMaxErrors(tcConfigB, exiter, "ConsoleErrorLoggerUpToMaxErrors") with member _.HandleTooManyErrors(text : string) = - DoWithErrorColor false (fun () -> Printf.eprintfn "%s" text) + DoWithDiagnosticColor FSharpDiagnosticSeverity.Warning (fun () -> Printf.eprintfn "%s" text) - member _.HandleIssue(tcConfigB, err, isError) = - DoWithErrorColor isError (fun () -> - let diag = OutputDiagnostic (tcConfigB.implicitIncludeDir, tcConfigB.showFullPaths, tcConfigB.flatErrors, tcConfigB.errorStyle, isError) + member _.HandleIssue(tcConfigB, err, severity) = + DoWithDiagnosticColor severity (fun () -> + let diag = OutputDiagnostic (tcConfigB.implicitIncludeDir, tcConfigB.showFullPaths, tcConfigB.flatErrors, tcConfigB.errorStyle, severity) writeViaBuffer stderr diag err stderr.WriteLine()) } :> ErrorLogger @@ -141,16 +142,21 @@ type InProcErrorLoggerProvider() = { new ErrorLoggerUpToMaxErrors(tcConfigBuilder, exiter, "InProcCompilerErrorLoggerUpToMaxErrors") with - member this.HandleTooManyErrors text = warnings.Add(Diagnostic.Short(false, text)) + member this.HandleTooManyErrors text = + warnings.Add(Diagnostic.Short(FSharpDiagnosticSeverity.Warning, text)) - member this.HandleIssue(tcConfigBuilder, err, isError) = + member this.HandleIssue(tcConfigBuilder, err, severity) = // 'true' is passed for "suggestNames", since we want to suggest names with fsc.exe runs and this doesn't affect IDE perf - let errs = + let diagnostics = CollectDiagnostic (tcConfigBuilder.implicitIncludeDir, tcConfigBuilder.showFullPaths, - tcConfigBuilder.flatErrors, tcConfigBuilder.errorStyle, isError, err, true) - let container = if isError then errors else warnings - container.AddRange(errs) } + tcConfigBuilder.flatErrors, tcConfigBuilder.errorStyle, severity, err, true) + match severity with + | FSharpDiagnosticSeverity.Error -> + errors.AddRange(diagnostics) + | FSharpDiagnosticSeverity.Warning -> + warnings.AddRange(diagnostics) + | _ -> ()} :> ErrorLogger } member _.CapturedErrors = errors.ToArray() @@ -299,42 +305,6 @@ let ProcessCommandLineFlags (tcConfigB: TcConfigBuilder, lcidFromCodePage, argv) dllFiles |> List.iter (fun f->tcConfigB.AddReferencedAssemblyByPath(rangeStartup, f)) sourceFiles -let EncodeSignatureData(tcConfig: TcConfig, tcGlobals, exportRemapping, generatedCcu, outfile, isIncrementalBuild) = - if tcConfig.GenerateSignatureData then - let resource = WriteSignatureData (tcConfig, tcGlobals, exportRemapping, generatedCcu, outfile, isIncrementalBuild) - // The resource gets written to a file for FSharp.Core - let useDataFiles = (tcConfig.useOptimizationDataFile || tcGlobals.compilingFslib) && not isIncrementalBuild - if useDataFiles then - let sigDataFileName = (Filename.chopExtension outfile)+".sigdata" - let bytes = resource.GetBytes() - use fileStream = File.Create(sigDataFileName, bytes.Length) - bytes.CopyTo fileStream - let resources = - [ resource ] - let sigAttr = mkSignatureDataVersionAttr tcGlobals (IL.parseILVersion Internal.Utilities.FSharpEnvironment.FSharpBinaryMetadataFormatRevision) - [sigAttr], resources - else - [], [] - -let EncodeOptimizationData(tcGlobals, tcConfig: TcConfig, outfile, exportRemapping, data, isIncrementalBuild) = - if tcConfig.GenerateOptimizationData then - let data = map2Of2 (Optimizer.RemapOptimizationInfo tcGlobals exportRemapping) data - // As with the sigdata file, the optdata gets written to a file for FSharp.Core - let useDataFiles = (tcConfig.useOptimizationDataFile || tcGlobals.compilingFslib) && not isIncrementalBuild - if useDataFiles then - let ccu, modulInfo = data - let bytes = TypedTreePickle.pickleObjWithDanglingCcus isIncrementalBuild outfile tcGlobals ccu Optimizer.p_CcuOptimizationInfo modulInfo - let optDataFileName = (Filename.chopExtension outfile)+".optdata" - File.WriteAllBytes(optDataFileName, bytes) - let (ccu, optData) = - if tcConfig.onlyEssentialOptimizationData then - map2Of2 Optimizer.AbstractOptimizationInfoToEssentials data - else - data - [ WriteOptimizationData (tcGlobals, outfile, isIncrementalBuild, ccu, optData) ] - else - [ ] - /// Write a .fsi file for the --sig option module InterfaceFileWriter = @@ -549,13 +519,12 @@ let main1(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, List.zip sourceFiles isLastCompiland // PERF: consider making this parallel, once uses of global state relevant to parsing are cleaned up - |> List.choose (fun (sourceFile, isLastCompiland) -> + |> List.map (fun (sourceFile, isLastCompiland) -> let sourceFileDirectory = Path.GetDirectoryName sourceFile - match ParseOneInputFile(tcConfig, lexResourceManager, ["COMPILED"], sourceFile, (isLastCompiland, isExe), errorLogger, (*retryLocked*)false) with - | Some input -> Some (input, sourceFileDirectory) - | None -> None) + let input = ParseOneInputFile(tcConfig, lexResourceManager, ["COMPILED"], sourceFile, (isLastCompiland, isExe), errorLogger, (*retryLocked*)false) + (input, sourceFileDirectory)) with e -> errorRecoveryNoRange e diff --git a/src/fsharp/fsc.fsi b/src/fsharp/fsc.fsi index eac96cdb51f..1af3290a3ec 100755 --- a/src/fsharp/fsc.fsi +++ b/src/fsharp/fsc.fsi @@ -25,16 +25,6 @@ type ConsoleLoggerProvider = new : unit -> ConsoleLoggerProvider inherit ErrorLoggerProvider -/// Encode the F# interface data into a set of IL attributes and resources -val EncodeSignatureData: - tcConfig:TcConfig * - tcGlobals:TcGlobals * - exportRemapping:Remap * - generatedCcu: CcuThunk * - outfile: string * - isIncrementalBuild: bool - -> ILAttribute list * ILResource list - /// The main (non-incremental) compilation entry point used by fsc.exe val mainCompile: ctok: CompilationThreadToken * diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index dcde18e9a44..303f20e8439 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -526,11 +526,11 @@ type internal FsiStdinSyphon(errorWriter: TextWriter) = /// Display the given error. member syphon.PrintError (tcConfig:TcConfigBuilder, err) = Utilities.ignoreAllErrors (fun () -> - let isError = true - DoWithErrorColor isError (fun () -> + let severity = FSharpDiagnosticSeverity.Error + DoWithDiagnosticColor severity (fun () -> errorWriter.WriteLine(); writeViaBuffer errorWriter (OutputDiagnosticContext " " syphon.GetLine) err; - writeViaBuffer errorWriter (OutputDiagnostic (tcConfig.implicitIncludeDir,tcConfig.showFullPaths,tcConfig.flatErrors,tcConfig.errorStyle,isError)) err; + writeViaBuffer errorWriter (OutputDiagnostic (tcConfig.implicitIncludeDir,tcConfig.showFullPaths,tcConfig.flatErrors,tcConfig.errorStyle,severity)) err; errorWriter.WriteLine() errorWriter.WriteLine() errorWriter.Flush())) @@ -564,19 +564,19 @@ type internal ErrorLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, fsiStd member x.ResetErrorCount() = (errorCount <- 0) - override x.DiagnosticSink(err, isError) = - if isError || ReportWarningAsError tcConfigB.errorSeverityOptions err then + override x.DiagnosticSink(err, severity) = + if (severity = FSharpDiagnosticSeverity.Error) || ReportWarningAsError tcConfigB.errorSeverityOptions err then fsiStdinSyphon.PrintError(tcConfigB,err) errorCount <- errorCount + 1 if tcConfigB.abortOnError then exit 1 (* non-zero exit code *) // STOP ON FIRST ERROR (AVOIDS PARSER ERROR RECOVERY) raise StopProcessing else - DoWithErrorColor isError (fun () -> + DoWithDiagnosticColor severity (fun () -> if ReportWarning tcConfigB.errorSeverityOptions err then fsiConsoleOutput.Error.WriteLine() writeViaBuffer fsiConsoleOutput.Error (OutputDiagnosticContext " " fsiStdinSyphon.GetLine) err - writeViaBuffer fsiConsoleOutput.Error (OutputDiagnostic (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.errorStyle,isError)) err + writeViaBuffer fsiConsoleOutput.Error (OutputDiagnostic (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.errorStyle,severity)) err fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.Flush()) @@ -1249,7 +1249,7 @@ type internal FsiDynamicCompiler // Typecheck. The lock stops the type checker running at the same time as the // server intellisense implementation (which is currently incomplete and #if disabled) - let (tcState:TcState),topCustomAttrs,declaredImpls,tcEnvAtEndOfLastInput = + let (tcState:TcState), topCustomAttrs, declaredImpls, tcEnvAtEndOfLastInput = lock tcLockObject (fun _ -> TypeCheckClosedInputSet(ctok, errorLogger.CheckForErrors, tcConfig, tcImports, tcGlobals, Some prefixPath, tcState, inputs)) let codegenResults, optEnv, fragName = ProcessTypedImpl(errorLogger, optEnv, tcState, tcConfig, isInteractiveItExpr, topCustomAttrs, prefixPath, isIncrementalFragment, declaredImpls, ilxGenerator) @@ -1592,13 +1592,11 @@ type internal FsiDynamicCompiler let parsedInput = match input.SyntaxTree with | None -> ParseOneInputFile(tcConfig,lexResourceManager,["INTERACTIVE"],input.FileName,(true,false),errorLogger,(*retryLocked*)false) - | _-> input.SyntaxTree + | Some parseTree -> parseTree input.FileName, parsedInput) |> List.unzip errorLogger.AbortOnError(fsiConsoleOutput); - if inputs |> List.exists Option.isNone then failwith "parse error" - let inputs = List.map Option.get inputs let istate = (istate, sourceFiles, inputs) |||> List.fold2 (fun istate sourceFile input -> fsiDynamicCompiler.ProcessMetaCommandsFromInputAsInteractiveCommands(ctok, istate, sourceFile, input)) fsiDynamicCompiler.EvalParsedSourceFiles (ctok, errorLogger, istate, inputs) @@ -2915,7 +2913,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i | Choice2Of2 (Some userExn) -> raise (makeNestedException userExn) let commitResultNonThrowing errorOptions scriptFile (errorLogger: CompilationErrorLogger) res = - let errs = errorLogger.GetErrors() + let errs = errorLogger.GetDiagnostics() let errorInfos = DiagnosticHelpers.CreateDiagnostics (errorOptions, true, scriptFile, errs, true) let userRes = match res with diff --git a/src/fsharp/import.fs b/src/fsharp/import.fs index 0bd815b755c..089502f2c89 100644 --- a/src/fsharp/import.fs +++ b/src/fsharp/import.fs @@ -361,7 +361,7 @@ let ImportProvidedMethodBaseAsILMethodRef (env: ImportMap) (m: range) (mbase: Ta | None -> let methodName = minfo.PUntaint((fun minfo -> minfo.Name), m) let typeName = declaringGenericTypeDefn.PUntaint((fun declaringGenericTypeDefn -> declaringGenericTypeDefn.FullName), m) - error(NumberedError(FSComp.SR.etIncorrectProvidedMethod(ExtensionTyping.DisplayNameOfTypeProvider(minfo.TypeProvider, m), methodName, metadataToken, typeName), m)) + error(Error(FSComp.SR.etIncorrectProvidedMethod(ExtensionTyping.DisplayNameOfTypeProvider(minfo.TypeProvider, m), methodName, metadataToken, typeName), m)) | _ -> match mbase.OfType() with | Some cinfo when cinfo.PUntaint((fun x -> x.DeclaringType.IsGenericType), m) -> @@ -387,7 +387,7 @@ let ImportProvidedMethodBaseAsILMethodRef (env: ImportMap) (m: range) (mbase: Ta | Some found -> found.Coerce(m) | None -> let typeName = declaringGenericTypeDefn.PUntaint((fun x -> x.FullName), m) - error(NumberedError(FSComp.SR.etIncorrectProvidedConstructor(ExtensionTyping.DisplayNameOfTypeProvider(cinfo.TypeProvider, m), typeName), m)) + error(Error(FSComp.SR.etIncorrectProvidedConstructor(ExtensionTyping.DisplayNameOfTypeProvider(cinfo.TypeProvider, m), typeName), m)) | _ -> mbase let rty = diff --git a/src/fsharp/service/ExternalSymbol.fsi b/src/fsharp/service/ExternalSymbol.fsi index 8c85cddc88c..1a0492d3c27 100644 --- a/src/fsharp/service/ExternalSymbol.fsi +++ b/src/fsharp/service/ExternalSymbol.fsi @@ -7,7 +7,7 @@ open FSharp.Compiler.AbstractIL.IL /// Represents a type in an external (non F#) assembly. [] -type FindDeclExternalType = +type public FindDeclExternalType = /// Type defined in non-F# assembly. | Type of fullName: string * genericArgs: FindDeclExternalType list @@ -22,12 +22,12 @@ type FindDeclExternalType = override ToString : unit -> string -module FindDeclExternalType = +module internal FindDeclExternalType = val internal tryOfILType : string array -> ILType -> FindDeclExternalType option /// Represents the type of a single method parameter [] -type FindDeclExternalParam = +type public FindDeclExternalParam = member IsByRef: bool @@ -37,7 +37,7 @@ type FindDeclExternalParam = override ToString : unit -> string -module FindDeclExternalParam = +module internal FindDeclExternalParam = val internal tryOfILType : string array -> ILType -> FindDeclExternalParam option @@ -45,7 +45,7 @@ module FindDeclExternalParam = /// Represents a symbol in an external (non F#) assembly [] -type FindDeclExternalSymbol = +type public FindDeclExternalSymbol = | Type of fullName: string | Constructor of typeName: string * args: FindDeclExternalParam list diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index c32ee9b348d..081e08874bb 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -53,6 +53,51 @@ open Internal.Utilities open Internal.Utilities.Collections open FSharp.Compiler.AbstractIL.ILBinaryReader +type FSharpUnresolvedReferencesSet = FSharpUnresolvedReferencesSet of UnresolvedAssemblyReference list + +// NOTE: may be better just to move to optional arguments here +type FSharpProjectOptions = + { + ProjectFileName: string + ProjectId: string option + SourceFiles: string[] + OtherOptions: string[] + ReferencedProjects: (string * FSharpProjectOptions)[] + IsIncompleteTypeCheckEnvironment : bool + UseScriptResolutionRules : bool + LoadTime : System.DateTime + UnresolvedReferences : FSharpUnresolvedReferencesSet option + OriginalLoadReferences: (range * string * string) list + Stamp : int64 option + } + + static member UseSameProject(options1,options2) = + match options1.ProjectId, options2.ProjectId with + | Some(projectId1), Some(projectId2) when not (String.IsNullOrWhiteSpace(projectId1)) && not (String.IsNullOrWhiteSpace(projectId2)) -> + projectId1 = projectId2 + | Some(_), Some(_) + | None, None -> options1.ProjectFileName = options2.ProjectFileName + | _ -> false + + static member AreSameForChecking(options1,options2) = + match options1.Stamp, options2.Stamp with + | Some x, Some y -> (x = y) + | _ -> + FSharpProjectOptions.UseSameProject(options1, options2) && + options1.SourceFiles = options2.SourceFiles && + options1.OtherOptions = options2.OtherOptions && + options1.UnresolvedReferences = options2.UnresolvedReferences && + options1.OriginalLoadReferences = options2.OriginalLoadReferences && + options1.ReferencedProjects.Length = options2.ReferencedProjects.Length && + Array.forall2 (fun (n1,a) (n2,b) -> + n1 = n2 && + FSharpProjectOptions.AreSameForChecking(a,b)) options1.ReferencedProjects options2.ReferencedProjects && + options1.LoadTime = options2.LoadTime + + member po.ProjectDirectory = System.IO.Path.GetDirectoryName(po.ProjectFileName) + + override this.ToString() = "FSharpProjectOptions(" + this.ProjectFileName + ")" + [] module internal FSharpCheckerResultsSettings = @@ -169,6 +214,7 @@ type internal TypeCheckInfo tcAccessRights: AccessorDomain, projectFileName: string, mainInputFileName: string, + projectOptions: FSharpProjectOptions, sResolutions: TcResolutions, sSymbolUses: TcSymbolUses, // This is a name resolution environment to use if no better match can be found. @@ -451,25 +497,23 @@ type internal TypeCheckInfo GetPreciseCompletionListFromExprTypingsResult.None | _ -> let bestQual, textChanged = - match parseResults.ParseTree with - | Some(input) -> - match ParsedInput.GetRangeOfExprLeftOfDot(endOfExprPos,Some(input)) with // TODO we say "colAtEndOfNames" everywhere, but that's not really a good name ("foo . $" hit Ctrl-Space at $) - | Some( exprRange) -> - // We have an up-to-date sync parse, and know the exact range of the prior expression. - // The quals all already have the same ending position, so find one with a matching starting position, if it exists. - // If not, then the stale typecheck info does not have a capturedExpressionTyping for this exact expression, and the - // user can wait for typechecking to catch up and second-chance intellisense to give the right result. - let qual = - quals |> Array.tryFind (fun (_,_,_,r) -> - ignore(r) // for breakpoint - posEq exprRange.Start r.Start) - qual, false - | None -> - // TODO In theory I think we should never get to this code path; it would be nice to add an assert. - // In practice, we do get here in some weird cases like "2.0 .. 3.0" and hitting Ctrl-Space in between the two dots of the range operator. - // I wasn't able to track down what was happening in those weird cases, not worth worrying about, it doesn't manifest as a product bug or anything. - None, false - | _ -> None, false + let input = parseResults.ParseTree + match ParsedInput.GetRangeOfExprLeftOfDot(endOfExprPos,input) with // TODO we say "colAtEndOfNames" everywhere, but that's not really a good name ("foo . $" hit Ctrl-Space at $) + | Some( exprRange) -> + // We have an up-to-date sync parse, and know the exact range of the prior expression. + // The quals all already have the same ending position, so find one with a matching starting position, if it exists. + // If not, then the stale typecheck info does not have a capturedExpressionTyping for this exact expression, and the + // user can wait for typechecking to catch up and second-chance intellisense to give the right result. + let qual = + quals |> Array.tryFind (fun (_,_,_,r) -> + ignore(r) // for breakpoint + posEq exprRange.Start r.Start) + qual, false + | None -> + // TODO In theory I think we should never get to this code path; it would be nice to add an assert. + // In practice, we do get here in some weird cases like "2.0 .. 3.0" and hitting Ctrl-Space in between the two dots of the range operator. + // I wasn't able to track down what was happening in those weird cases, not worth worrying about, it doesn't manifest as a product bug or anything. + None, false match bestQual with | Some bestQual -> @@ -790,7 +834,7 @@ type internal TypeCheckInfo // Look for a "special" completion context let completionContext = parseResultsOpt - |> Option.bind (fun x -> x.ParseTree) + |> Option.map (fun x -> x.ParseTree) |> Option.bind (fun parseTree -> ParsedInput.TryGetCompletionContext(mkPos line colAtEndOfNamesAndResidue, parseTree, lineStr)) let res = @@ -966,7 +1010,7 @@ type internal TypeCheckInfo let getAccessibility item = FSharpSymbol.Create(cenv, item).Accessibility let currentNamespaceOrModule = parseResultsOpt - |> Option.bind (fun x -> x.ParseTree) + |> Option.map (fun x -> x.ParseTree) |> Option.map (fun parsedInput -> ParsedInput.GetFullNameOfSmallestModuleOrNamespaceAtPoint(mkPos line 0, parsedInput)) let isAttributeApplication = ctx = Some CompletionContext.AttributeApplication DeclarationListInfo.Create(infoReader,m,denv,getAccessibility,items,currentNamespaceOrModule,isAttributeApplication)) @@ -1348,6 +1392,8 @@ type internal TypeCheckInfo member _.AccessRights = tcAccessRights + member _.ProjectOptions = projectOptions + member _.GetReferencedAssemblies() = [ for x in tcImports.GetImportedAssemblies() do yield FSharpAssembly(g, tcImports, x.FSharpViewOfMetadata) ] @@ -1448,7 +1494,7 @@ module internal ParseAndCheckFile = else exn if reportErrors then let report exn = - for ei in DiagnosticHelpers.ReportError (options, false, mainInputFileName, fileInfo, (exn, sev), suggestNamesForErrors) do + for ei in DiagnosticHelpers.ReportDiagnostic (options, false, mainInputFileName, fileInfo, (exn, sev), suggestNamesForErrors) do errorsAndWarningsCollector.Add ei if sev = FSharpDiagnosticSeverity.Error then errorCount <- errorCount + 1 @@ -1461,7 +1507,7 @@ module internal ParseAndCheckFile = let errorLogger = { new ErrorLogger("ErrorHandler") with - member x.DiagnosticSink (exn, isError) = diagnosticSink (if isError then FSharpDiagnosticSeverity.Error else FSharpDiagnosticSeverity.Warning) exn + member x.DiagnosticSink (exn, severity) = diagnosticSink severity exn member x.ErrorCount = errorCount } // Public members @@ -1605,10 +1651,10 @@ module internal ParseAndCheckFile = let isExe = options.IsExe try - Some (ParseInput(lexfun, errHandler.ErrorLogger, lexbuf, None, fileName, (isLastCompiland, isExe))) + ParseInput(lexfun, errHandler.ErrorLogger, lexbuf, None, fileName, (isLastCompiland, isExe)) with e -> errHandler.ErrorLogger.StopProcessingRecovery e Range.range0 // don't re-raise any exceptions, we must return None. - None) + EmptyParsedInput(fileName, (isLastCompiland, isExe))) errHandler.CollectedDiagnostics, parseResult, errHandler.AnyErrors @@ -1679,6 +1725,7 @@ module internal ParseAndCheckFile = (parseResults: FSharpParseFileResults, sourceText: ISourceText, mainInputFileName: string, + projectOptions: FSharpProjectOptions, projectFileName: string, tcConfig: TcConfig, tcGlobals: TcGlobals, @@ -1694,12 +1741,7 @@ module internal ParseAndCheckFile = use _logBlock = Logger.LogBlock LogCompilerFunctionId.Service_CheckOneFile - match parseResults.ParseTree with - // When processing the following cases, we don't need to type-check - | None -> return [||], Result.Error() - - // Run the type checker... - | Some parsedMainInput -> + let parsedMainInput = parseResults.ParseTree // Initialize the error handler let errHandler = new ErrorHandler(true, mainInputFileName, tcConfig.errorSeverityOptions, sourceText, suggestNamesForErrors) @@ -1714,8 +1756,8 @@ module internal ParseAndCheckFile = errHandler.ErrorSeverityOptions <- tcConfig.errorSeverityOptions // Play background errors and warnings for this file. - for err, sev in backgroundDiagnostics do - diagnosticSink (err, (sev = FSharpDiagnosticSeverity.Error)) + for err, severity in backgroundDiagnostics do + diagnosticSink (err, severity) // If additional references were brought in by the preprocessor then we need to process them ApplyLoadClosure(tcConfig, parsedMainInput, mainInputFileName, loadClosure, tcImports, backgroundDiagnostics) @@ -1774,6 +1816,7 @@ module internal ParseAndCheckFile = tcEnvAtEnd.AccessRights, projectFileName, mainInputFileName, + projectOptions, sink.GetResolutions(), sink.GetSymbolUses(), tcEnvAtEnd.NameEnv, @@ -1788,9 +1831,10 @@ module internal ParseAndCheckFile = [] -type FSharpProjectContext(thisCcu: CcuThunk, assemblies: FSharpAssembly list, ad: AccessorDomain) = +type FSharpProjectContext(thisCcu: CcuThunk, assemblies: FSharpAssembly list, ad: AccessorDomain, projectOptions: FSharpProjectOptions) = + + member _.ProjectOptions = projectOptions - /// Get the assemblies referenced member _.GetReferencedAssemblies() = assemblies member _.AccessibilityRights = FSharpAccessibilityRights(thisCcu, ad) @@ -1799,8 +1843,7 @@ type FSharpProjectContext(thisCcu: CcuThunk, assemblies: FSharpAssembly list, ad [] /// A live object of this type keeps the background corresponding background builder (and type providers) alive (through reference-counting). // -// There is an important property of all the objects returned by the methods of this type: they do not require -// the corresponding background builder to be alive. That is, they are simply plain-old-data through pre-formatting of all result text. +// Note: objects returned by the methods of this type do not require the corresponding background builder to be alive. type FSharpCheckFileResults (filename: string, errors: FSharpDiagnostic[], @@ -1809,6 +1852,7 @@ type FSharpCheckFileResults builderX: IncrementalBuilder option, keepAssemblyContents: bool) = + // Here 'details' keeps 'builder' alive let details = match scopeOptX with None -> None | Some scopeX -> Some (scopeX, builderX) // Run an operation that can be called from any thread @@ -1821,10 +1865,10 @@ type FSharpCheckFileResults member _.HasFullTypeCheckInfo = details.IsSome - member _.TryGetCurrentTcImports () = - match builderX with - | Some builder -> builder.TryGetCurrentTcImports () - | _ -> None + member _.TryGetCurrentTcImports () = + match details with + | None -> None + | Some (scope, _builderOpt) -> Some scope.TcImports /// Intellisense autocompletions member _.GetDeclarationListInfo(parsedFileResults, line, lineText, partialName, ?getAllEntities) = @@ -1888,29 +1932,25 @@ type FSharpCheckFileResults threadSafeOp (fun () -> [| |]) (fun scope -> - // This operation is not asynchronous - GetFormatSpecifierLocationsAndArity can be run on the calling thread scope.GetFormatSpecifierLocationsAndArity()) member _.GetSemanticClassification(range: range option) = threadSafeOp (fun () -> [| |]) (fun scope -> - // This operation is not asynchronous - GetSemanticClassification can be run on the calling thread scope.GetSemanticClassification(range)) member _.PartialAssemblySignature = threadSafeOp (fun () -> failwith "not available") (fun scope -> - // This operation is not asynchronous - PartialAssemblySignature can be run on the calling thread scope.PartialAssemblySignatureForFile) member _.ProjectContext = threadSafeOp (fun () -> failwith "not available") (fun scope -> - // This operation is not asynchronous - GetReferencedAssemblies can be run on the calling thread - FSharpProjectContext(scope.ThisCcu, scope.GetReferencedAssemblies(), scope.AccessRights)) + FSharpProjectContext(scope.ThisCcu, scope.GetReferencedAssemblies(), scope.AccessRights, scope.ProjectOptions)) member _.DependencyFiles = dependencyFiles @@ -1995,6 +2035,7 @@ type FSharpCheckFileResults tcConfig, tcGlobals, isIncompleteTypeCheckEnvironment: bool, builder: IncrementalBuilder, + projectOptions, dependencyFiles, creationErrors: FSharpDiagnostic[], parseErrors: FSharpDiagnostic[], @@ -2009,7 +2050,9 @@ type FSharpCheckFileResults let tcFileInfo = TypeCheckInfo(tcConfig, tcGlobals, ccuSigForFile, thisCcu, tcImports, tcAccessRights, - projectFileName, mainInputFileName, sResolutions, sSymbolUses, + projectFileName, mainInputFileName, + projectOptions, + sResolutions, sSymbolUses, sFallback, loadClosure, implFileOpt, openDeclarations) @@ -2031,6 +2074,7 @@ type FSharpCheckFileResults reactorOps: IReactorOperations, userOpName: string, isIncompleteTypeCheckEnvironment: bool, + projectOptions: FSharpProjectOptions, builder: IncrementalBuilder, dependencyFiles: string[], creationErrors: FSharpDiagnostic[], @@ -2040,7 +2084,8 @@ type FSharpCheckFileResults async { let! tcErrors, tcFileInfo = ParseAndCheckFile.CheckOneFile - (parseResults, sourceText, mainInputFileName, projectFileName, tcConfig, tcGlobals, tcImports, + (parseResults, sourceText, mainInputFileName, projectOptions, + projectFileName, tcConfig, tcGlobals, tcImports, tcState, moduleNamesDict, loadClosure, backgroundDiagnostics, reactorOps, userOpName, suggestNamesForErrors) match tcFileInfo with @@ -2066,7 +2111,7 @@ type FSharpCheckProjectResults diagnostics: FSharpDiagnostic[], details:(TcGlobals * TcImports * CcuThunk * ModuleOrNamespaceType * TcSymbolUses list * TopAttribs option * IRawFSharpAssemblyData option * ILAssemblyRef * - AccessorDomain * TypedImplFile list option * string[]) option) = + AccessorDomain * TypedImplFile list option * string[] * FSharpProjectOptions) option) = let getDetails() = match details with @@ -2083,12 +2128,12 @@ type FSharpCheckProjectResults member _.HasCriticalErrors = details.IsNone member _.AssemblySignature = - let (tcGlobals, tcImports, thisCcu, ccuSig, _tcSymbolUses, topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles) = getDetails() + let (tcGlobals, tcImports, thisCcu, ccuSig, _tcSymbolUses, topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() FSharpAssemblySignature(tcGlobals, thisCcu, ccuSig, tcImports, topAttribs, ccuSig) member _.TypedImplementationFiles = if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" - let (tcGlobals, tcImports, thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, tcAssemblyExpr, _dependencyFiles) = getDetails() + let (tcGlobals, tcImports, thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() let mimpls = match tcAssemblyExpr with | None -> [] @@ -2097,7 +2142,7 @@ type FSharpCheckProjectResults member info.AssemblyContents = if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" - let (tcGlobals, tcImports, thisCcu, ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, tcAssemblyExpr, _dependencyFiles) = getDetails() + let (tcGlobals, tcImports, thisCcu, ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() let mimpls = match tcAssemblyExpr with | None -> [] @@ -2106,7 +2151,7 @@ type FSharpCheckProjectResults member _.GetOptimizedAssemblyContents() = if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" - let (tcGlobals, tcImports, thisCcu, ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, tcAssemblyExpr, _dependencyFiles) = getDetails() + let (tcGlobals, tcImports, thisCcu, ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() let mimpls = match tcAssemblyExpr with | None -> [] @@ -2125,7 +2170,7 @@ type FSharpCheckProjectResults // Not, this does not have to be a SyncOp, it can be called from any thread member _.GetUsesOfSymbol(symbol:FSharpSymbol, ?cancellationToken: CancellationToken) = - let (tcGlobals, _tcImports, _thisCcu, _ccuSig, tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles) = getDetails() + let (tcGlobals, _tcImports, _thisCcu, _ccuSig, tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() tcSymbolUses |> Seq.collect (fun r -> r.GetUsesOfSymbol symbol.Item) @@ -2138,7 +2183,7 @@ type FSharpCheckProjectResults // Not, this does not have to be a SyncOp, it can be called from any thread member _.GetAllUsesOfAllSymbols(?cancellationToken: CancellationToken) = - let (tcGlobals, tcImports, thisCcu, ccuSig, tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles) = getDetails() + let (tcGlobals, tcImports, thisCcu, ccuSig, tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() let cenv = SymbolEnv(tcGlobals, thisCcu, Some ccuSig, tcImports) [| for r in tcSymbolUses do @@ -2150,28 +2195,28 @@ type FSharpCheckProjectResults yield FSharpSymbolUse(tcGlobals, symbolUse.DisplayEnv, symbol, symbolUse.ItemOccurence, symbolUse.Range) |] member _.ProjectContext = - let (tcGlobals, tcImports, thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, ad, _tcAssemblyExpr, _dependencyFiles) = getDetails() + let (tcGlobals, tcImports, thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, ad, _tcAssemblyExpr, _dependencyFiles, projectOptions) = getDetails() let assemblies = tcImports.GetImportedAssemblies() |> List.map (fun x -> FSharpAssembly(tcGlobals, tcImports, x.FSharpViewOfMetadata)) - FSharpProjectContext(thisCcu, assemblies, ad) + FSharpProjectContext(thisCcu, assemblies, ad, projectOptions) member _.RawFSharpAssemblyData = - let (_tcGlobals, _tcImports, _thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles) = getDetails() + let (_tcGlobals, _tcImports, _thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() tcAssemblyData member _.DependencyFiles = - let (_tcGlobals, _tcImports, _thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, dependencyFiles) = getDetails() + let (_tcGlobals, _tcImports, _thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, dependencyFiles, _projectOptions) = getDetails() dependencyFiles member _.AssemblyFullName = - let (_tcGlobals, _tcImports, _thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles) = getDetails() + let (_tcGlobals, _tcImports, _thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles, _projectOptions) = getDetails() ilAssemRef.QualifiedName override _.ToString() = "FSharpCheckProjectResults(" + projectFileName + ")" type FsiInteractiveChecker(legacyReferenceResolver, - ops: IReactorOperations, + reactorOps: IReactorOperations, tcConfig: TcConfig, tcGlobals: TcGlobals, tcImports: TcImports, @@ -2186,9 +2231,9 @@ type FsiInteractiveChecker(legacyReferenceResolver, let suggestNamesForErrors = true // Will always be true, this is just for readability // Note: projectSourceFiles is only used to compute isLastCompiland, and is ignored if Build.IsScript(mainInputFileName) is true (which it is in this case). let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, [| filename |], true) - let parseErrors, parseTreeOpt, anyErrors = ParseAndCheckFile.parseFile (sourceText, filename, parsingOptions, userOpName, suggestNamesForErrors) + let parseErrors, parsedInput, anyErrors = ParseAndCheckFile.parseFile (sourceText, filename, parsingOptions, userOpName, suggestNamesForErrors) let dependencyFiles = [| |] // interactions have no dependencies - let parseResults = FSharpParseFileResults(parseErrors, parseTreeOpt, parseHadErrors = anyErrors, dependencyFiles = dependencyFiles) + let parseResults = FSharpParseFileResults(parseErrors, parsedInput, parseHadErrors = anyErrors, dependencyFiles = dependencyFiles) let backgroundDiagnostics = [| |] let reduceMemoryUsage = ReduceMemoryFlag.Yes @@ -2208,12 +2253,27 @@ type FsiInteractiveChecker(legacyReferenceResolver, reduceMemoryUsage=reduceMemoryUsage, dependencyProvider=tcImports.DependencyProvider) + let projectOptions = + { + ProjectFileName="script.fsproj" + ProjectId=None + SourceFiles=[||] + OtherOptions=[||] + ReferencedProjects=[||] + IsIncompleteTypeCheckEnvironment=false + UseScriptResolutionRules =false + LoadTime=System.DateTime.Now + UnresolvedReferences =None + OriginalLoadReferences = [] + Stamp = None + } + let! tcErrors, tcFileInfo = ParseAndCheckFile.CheckOneFile - (parseResults, sourceText, filename, "project", + (parseResults, sourceText, filename, projectOptions, projectOptions.ProjectFileName, tcConfig, tcGlobals, tcImports, tcState, Map.empty, Some loadClosure, backgroundDiagnostics, - ops, userOpName, suggestNamesForErrors) + reactorOps, userOpName, suggestNamesForErrors) return match tcFileInfo with @@ -2225,7 +2285,8 @@ type FsiInteractiveChecker(legacyReferenceResolver, keepAssemblyContents, errors, Some(tcGlobals, tcImports, tcFileInfo.ThisCcu, tcFileInfo.CcuSigForFile, [tcFileInfo.ScopeSymbolUses], None, None, mkSimpleAssemblyRef "stdin", - tcState.TcEnvFromImpls.AccessRights, None, dependencyFiles)) + tcState.TcEnvFromImpls.AccessRights, None, dependencyFiles, + projectOptions)) parseResults, typeCheckResults, projectResults diff --git a/src/fsharp/service/FSharpCheckerResults.fsi b/src/fsharp/service/FSharpCheckerResults.fsi index 9b08ddb74b4..0f519ca7572 100644 --- a/src/fsharp/service/FSharpCheckerResults.fsi +++ b/src/fsharp/service/FSharpCheckerResults.fsi @@ -2,6 +2,7 @@ namespace FSharp.Compiler.CodeAnalysis +open System open System.Threading open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.IL @@ -23,6 +24,64 @@ open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text +/// Unused in this API +type public FSharpUnresolvedReferencesSet = + internal + | FSharpUnresolvedReferencesSet of UnresolvedAssemblyReference list + +/// A set of information describing a project or script build configuration. +type public FSharpProjectOptions = + { + // Note that this may not reduce to just the project directory, because there may be two projects in the same directory. + ProjectFileName: string + + /// This is the unique identifier for the project, it is case sensitive. If it's None, will key off of ProjectFileName in our caching. + ProjectId: string option + + /// The files in the project + SourceFiles: string[] + + /// Additional command line argument options for the project. These can include additional files and references. + OtherOptions: string[] + + /// The command line arguments for the other projects referenced by this project, indexed by the + /// exact text used in the "-r:" reference in FSharpProjectOptions. + ReferencedProjects: (string * FSharpProjectOptions)[] + + /// When true, the typechecking environment is known a priori to be incomplete, for + /// example when a .fs file is opened outside of a project. In this case, the number of error + /// messages reported is reduced. + IsIncompleteTypeCheckEnvironment: bool + + /// When true, use the reference resolution rules for scripts rather than the rules for compiler. + UseScriptResolutionRules: bool + + /// Timestamp of project/script load, used to differentiate between different instances of a project load. + /// This ensures that a complete reload of the project or script type checking + /// context occurs on project or script unload/reload. + LoadTime: DateTime + + /// Unused in this API and should be 'None' when used as user-specified input + UnresolvedReferences: FSharpUnresolvedReferencesSet option + + /// Unused in this API and should be '[]' when used as user-specified input + OriginalLoadReferences: (range * string * string) list + + /// An optional stamp to uniquely identify this set of options + /// If two sets of options both have stamps, then they are considered equal + /// if and only if the stamps are equal + Stamp: int64 option + } + + /// Whether the two parse options refer to the same project. + static member internal UseSameProject: options1: FSharpProjectOptions * options2: FSharpProjectOptions -> bool + + /// Compare two options sets with respect to the parts of the options that are important to building. + static member internal AreSameForChecking: options1: FSharpProjectOptions * options2: FSharpProjectOptions -> bool + + /// Compute the project directory. + member internal ProjectDirectory: string + /// Represents the use of an F# symbol from F# source code [] type public FSharpSymbolUse = @@ -77,6 +136,9 @@ type public FSharpProjectContext = /// Get the accessibility rights for this project context w.r.t. InternalsVisibleTo attributes granting access to other assemblies member AccessibilityRights : FSharpAccessibilityRights + /// Get the project options + member ProjectOptions: FSharpProjectOptions + /// Options used to determine active --define conditionals and other options relevant to parsing files in a project type public FSharpParsingOptions = { @@ -255,6 +317,7 @@ type public FSharpCheckFileResults = tcGlobals: TcGlobals * isIncompleteTypeCheckEnvironment: bool * builder: IncrementalBuilder * + projectOptions: FSharpProjectOptions * dependencyFiles: string[] * creationErrors: FSharpDiagnostic[] * parseErrors: FSharpDiagnostic[] * @@ -288,6 +351,7 @@ type public FSharpCheckFileResults = reactorOps: IReactorOperations * userOpName: string * isIncompleteTypeCheckEnvironment: bool * + projectOptions: FSharpProjectOptions * builder: IncrementalBuilder * dependencyFiles: string[] * creationErrors:FSharpDiagnostic[] * @@ -345,7 +409,18 @@ type public FSharpCheckProjectResults = tcConfigOption: TcConfig option * keepAssemblyContents: bool * diagnostics: FSharpDiagnostic[] * - details:(TcGlobals * TcImports * CcuThunk * ModuleOrNamespaceType * TcSymbolUses list * TopAttribs option * IRawFSharpAssemblyData option * ILAssemblyRef * AccessorDomain * TypedImplFile list option * string[]) option + details:(TcGlobals * + TcImports * + CcuThunk * + ModuleOrNamespaceType * + TcSymbolUses list * + TopAttribs option * + IRawFSharpAssemblyData option * + ILAssemblyRef * + AccessorDomain * + TypedImplFile list option * + string[] * + FSharpProjectOptions) option -> FSharpCheckProjectResults module internal ParseAndCheckFile = @@ -356,7 +431,7 @@ module internal ParseAndCheckFile = options: FSharpParsingOptions * userOpName: string * suggestNamesForErrors: bool - -> FSharpDiagnostic[] * ParsedInput option * bool + -> FSharpDiagnostic[] * ParsedInput * bool val matchBraces: sourceText: ISourceText * @@ -371,7 +446,7 @@ module internal ParseAndCheckFile = type internal FsiInteractiveChecker = internal new: LegacyReferenceResolver * - ops: IReactorOperations * + reactorOps: IReactorOperations * tcConfig: TcConfig * tcGlobals: TcGlobals * tcImports: TcImports * diff --git a/src/fsharp/service/FSharpParseFileResults.fs b/src/fsharp/service/FSharpParseFileResults.fs index 131826d4b7b..923097f8078 100644 --- a/src/fsharp/service/FSharpParseFileResults.fs +++ b/src/fsharp/service/FSharpParseFileResults.fs @@ -75,7 +75,7 @@ type CompletionContext = //---------------------------------------------------------------------------- [] -type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput option, parseHadErrors: bool, dependencyFiles: string[]) = +type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, parseHadErrors: bool, dependencyFiles: string[]) = member _.Diagnostics = diagnostics @@ -83,7 +83,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput member _.ParseTree = input - member scope.TryRangeOfNameOfNearestOuterBindingContainingPos pos = + member _.TryRangeOfNameOfNearestOuterBindingContainingPos pos = let tryGetIdentRangeFromBinding binding = match binding with | SynBinding(_, _, _, _, _, _, _, headPat, _, _, _, _) -> @@ -121,61 +121,52 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput | _ -> Some workingRange - match scope.ParseTree with - | Some input -> - SyntaxTraversal.Traverse(pos, input, { new SyntaxVisitorBase<_>() with - member _.VisitExpr(_, _, defaultTraverse, expr) = - defaultTraverse expr + SyntaxTraversal.Traverse(pos, input, { new SyntaxVisitorBase<_>() with + override _.VisitExpr(_, _, defaultTraverse, expr) = + defaultTraverse expr - override _.VisitBinding(_path, defaultTraverse, binding) = - match binding with - | SynBinding(_, _, _, _, _, _, _, _, _, expr, _range, _) as b when rangeContainsPos b.RangeOfBindingWithRhs pos -> - match tryGetIdentRangeFromBinding b with - | Some range -> walkBinding expr range - | None -> None - | _ -> defaultTraverse binding }) - | None -> None + override _.VisitBinding(_path, defaultTraverse, binding) = + match binding with + | SynBinding(_, _, _, _, _, _, _, _, _, expr, _range, _) as b when rangeContainsPos b.RangeOfBindingWithRhs pos -> + match tryGetIdentRangeFromBinding b with + | Some range -> walkBinding expr range + | None -> None + | _ -> defaultTraverse binding }) - member scope.TryIdentOfPipelineContainingPosAndNumArgsApplied pos = - match scope.ParseTree with - | Some input -> + member _.TryIdentOfPipelineContainingPosAndNumArgsApplied pos = + SyntaxTraversal.Traverse(pos, input, { new SyntaxVisitorBase<_>() with + member _.VisitExpr(_, _, defaultTraverse, expr) = + match expr with + | SynExpr.App (_, _, SynExpr.App(_, true, SynExpr.Ident ident, _, _), argExpr, _) when rangeContainsPos argExpr.Range pos -> + match argExpr with + | SynExpr.App(_, _, _, SynExpr.Paren(expr, _, _, _), _) when rangeContainsPos expr.Range pos -> + None + | _ -> + if ident.idText = "op_PipeRight" then + Some (ident, 1) + elif ident.idText = "op_PipeRight2" then + Some (ident, 2) + elif ident.idText = "op_PipeRight3" then + Some (ident, 3) + else + None + | _ -> defaultTraverse expr + }) + + member _.IsPosContainedInApplication pos = + let result = SyntaxTraversal.Traverse(pos, input, { new SyntaxVisitorBase<_>() with - member _.VisitExpr(_, _, defaultTraverse, expr) = + member _.VisitExpr(_, traverseSynExpr, defaultTraverse, expr) = match expr with - | SynExpr.App (_, _, SynExpr.App(_, true, SynExpr.Ident ident, _, _), argExpr, _) when rangeContainsPos argExpr.Range pos -> - match argExpr with - | SynExpr.App(_, _, _, SynExpr.Paren(expr, _, _, _), _) when rangeContainsPos expr.Range pos -> - None - | _ -> - if ident.idText = "op_PipeRight" then - Some (ident, 1) - elif ident.idText = "op_PipeRight2" then - Some (ident, 2) - elif ident.idText = "op_PipeRight3" then - Some (ident, 3) - else - None + | SynExpr.App(_, _, _, SynExpr.CompExpr (_, _, expr, _), range) when rangeContainsPos range pos -> + traverseSynExpr expr + | SynExpr.App (_, _, _, _, range) when rangeContainsPos range pos -> + Some range | _ -> defaultTraverse expr }) - | None -> None - - member scope.IsPosContainedInApplication pos = - match scope.ParseTree with - | Some input -> - let result = - SyntaxTraversal.Traverse(pos, input, { new SyntaxVisitorBase<_>() with - member _.VisitExpr(_, traverseSynExpr, defaultTraverse, expr) = - match expr with - | SynExpr.App(_, _, _, SynExpr.CompExpr (_, _, expr, _), range) when rangeContainsPos range pos -> - traverseSynExpr expr - | SynExpr.App (_, _, _, _, range) when rangeContainsPos range pos -> - Some range - | _ -> defaultTraverse expr - }) - result.IsSome - | None -> false - - member scope.TryRangeOfFunctionOrMethodBeingApplied pos = + result.IsSome + + member _.TryRangeOfFunctionOrMethodBeingApplied pos = let rec getIdentRangeForFuncExprInApp traverseSynExpr expr pos = match expr with | SynExpr.Ident ident -> Some ident.idRange @@ -275,24 +266,18 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput traverseSynExpr expr |> Option.map (fun expr -> expr) - match scope.ParseTree with - | Some input -> - SyntaxTraversal.Traverse(pos, input, { new SyntaxVisitorBase<_>() with - member _.VisitExpr(_, traverseSynExpr, defaultTraverse, expr) = - match expr with - | SynExpr.App (_, _, _funcExpr, _, range) as app when rangeContainsPos range pos -> - getIdentRangeForFuncExprInApp traverseSynExpr app pos - | _ -> defaultTraverse expr - }) - | None -> None - + SyntaxTraversal.Traverse(pos, input, { new SyntaxVisitorBase<_>() with + member _.VisitExpr(_, traverseSynExpr, defaultTraverse, expr) = + match expr with + | SynExpr.App (_, _, _funcExpr, _, range) as app when rangeContainsPos range pos -> + getIdentRangeForFuncExprInApp traverseSynExpr app pos + | _ -> defaultTraverse expr + }) - member scope.GetAllArgumentsForFunctionApplicationAtPostion pos = - match input with - | Some input -> SynExprAppLocationsImpl.getAllCurriedArgsAtPosition pos input - | None -> None + member _.GetAllArgumentsForFunctionApplicationAtPostion pos = + SynExprAppLocationsImpl.getAllCurriedArgsAtPosition pos input - member scope.TryRangeOfParenEnclosingOpEqualsGreaterUsage opGreaterEqualPos = + member _.TryRangeOfParenEnclosingOpEqualsGreaterUsage opGreaterEqualPos = let (|Ident|_|) ofName = function | SynExpr.Ident ident when ident.idText = ofName -> Some () | _ -> None @@ -301,102 +286,81 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput Some (actualParamListExpr, actualLambdaBodyExpr) | _ -> None - match scope.ParseTree with - | Some parseTree -> - SyntaxTraversal.Traverse(opGreaterEqualPos, parseTree, { new SyntaxVisitorBase<_>() with - member _.VisitExpr(_, _, defaultTraverse, expr) = - match expr with - | SynExpr.Paren((InfixAppOfOpEqualsGreater(lambdaArgs, lambdaBody) as app), _, _, _) -> - Some (app.Range, lambdaArgs.Range, lambdaBody.Range) - | _ -> defaultTraverse expr + SyntaxTraversal.Traverse(opGreaterEqualPos, input, { new SyntaxVisitorBase<_>() with + member _.VisitExpr(_, _, defaultTraverse, expr) = + match expr with + | SynExpr.Paren((InfixAppOfOpEqualsGreater(lambdaArgs, lambdaBody) as app), _, _, _) -> + Some (app.Range, lambdaArgs.Range, lambdaBody.Range) + | _ -> defaultTraverse expr - member _.VisitBinding(_path, defaultTraverse, binding) = - match binding with - | SynBinding(_, SynBindingKind.Normal, _, _, _, _, _, _, _, (InfixAppOfOpEqualsGreater(lambdaArgs, lambdaBody) as app), _, _) -> - Some(app.Range, lambdaArgs.Range, lambdaBody.Range) - | _ -> defaultTraverse binding }) - | None -> None - - member scope.TryRangeOfExprInYieldOrReturn pos = - match scope.ParseTree with - | Some parseTree -> - SyntaxTraversal.Traverse(pos, parseTree, { new SyntaxVisitorBase<_>() with - member _.VisitExpr(_path, _, defaultTraverse, expr) = - match expr with - | SynExpr.YieldOrReturn(_, expr, range) - | SynExpr.YieldOrReturnFrom(_, expr, range) when rangeContainsPos range pos -> - Some expr.Range - | _ -> defaultTraverse expr }) - | None -> None - - member scope.TryRangeOfRecordExpressionContainingPos pos = - match input with - | Some input -> - SyntaxTraversal.Traverse(pos, input, { new SyntaxVisitorBase<_>() with - member _.VisitExpr(_, _, defaultTraverse, expr) = - match expr with - | SynExpr.Record(_, _, _, range) when rangeContainsPos range pos -> - Some range - | _ -> defaultTraverse expr }) - | None -> - None + member _.VisitBinding(_path, defaultTraverse, binding) = + match binding with + | SynBinding(_, SynBindingKind.Normal, _, _, _, _, _, _, _, (InfixAppOfOpEqualsGreater(lambdaArgs, lambdaBody) as app), _, _) -> + Some(app.Range, lambdaArgs.Range, lambdaBody.Range) + | _ -> defaultTraverse binding }) + + member _.TryRangeOfExprInYieldOrReturn pos = + SyntaxTraversal.Traverse(pos, input, { new SyntaxVisitorBase<_>() with + member _.VisitExpr(_path, _, defaultTraverse, expr) = + match expr with + | SynExpr.YieldOrReturn(_, expr, range) + | SynExpr.YieldOrReturnFrom(_, expr, range) when rangeContainsPos range pos -> + Some expr.Range + | _ -> defaultTraverse expr }) + + member _.TryRangeOfRecordExpressionContainingPos pos = + SyntaxTraversal.Traverse(pos, input, { new SyntaxVisitorBase<_>() with + member _.VisitExpr(_, _, defaultTraverse, expr) = + match expr with + | SynExpr.Record(_, _, _, range) when rangeContainsPos range pos -> + Some range + | _ -> defaultTraverse expr }) member _.TryRangeOfRefCellDereferenceContainingPos expressionPos = - match input with - | Some input -> - SyntaxTraversal.Traverse(expressionPos, input, { new SyntaxVisitorBase<_>() with - member _.VisitExpr(_, _, defaultTraverse, expr) = - match expr with - | SynExpr.App(_, false, SynExpr.Ident funcIdent, expr, _) -> - if funcIdent.idText = "op_Dereference" && rangeContainsPos expr.Range expressionPos then - Some funcIdent.idRange - else - None - | _ -> defaultTraverse expr }) - | None -> - None + SyntaxTraversal.Traverse(expressionPos, input, { new SyntaxVisitorBase<_>() with + member _.VisitExpr(_, _, defaultTraverse, expr) = + match expr with + | SynExpr.App(_, false, SynExpr.Ident funcIdent, expr, _) -> + if funcIdent.idText = "op_Dereference" && rangeContainsPos expr.Range expressionPos then + Some funcIdent.idRange + else + None + | _ -> defaultTraverse expr }) member _.FindParameterLocations pos = - match input with - | Some input -> ParameterLocations.Find(pos, input) - | _ -> None + ParameterLocations.Find(pos, input) member _.IsPositionContainedInACurriedParameter pos = - match input with - | Some input -> - let result = - SyntaxTraversal.Traverse(pos, input, { new SyntaxVisitorBase<_>() with - member _.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = - defaultTraverse(expr) - - override _.VisitBinding (_path, _, binding) = - match binding with - | SynBinding(_, _, _, _, _, _, valData, _, _, _, range, _) when rangeContainsPos range pos -> - let info = valData.SynValInfo.CurriedArgInfos - let mutable found = false - for group in info do - for arg in group do - match arg.Ident with - | Some ident when rangeContainsPos ident.idRange pos -> - found <- true - | _ -> () - if found then Some range else None - | _ -> - None - }) - result.IsSome - | _ -> false + let result = + SyntaxTraversal.Traverse(pos, input, { new SyntaxVisitorBase<_>() with + member _.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = + defaultTraverse(expr) + + override _.VisitBinding (_path, _, binding) = + match binding with + | SynBinding(_, _, _, _, _, _, valData, _, _, _, range, _) when rangeContainsPos range pos -> + let info = valData.SynValInfo.CurriedArgInfos + let mutable found = false + for group in info do + for arg in group do + match arg.Ident with + | Some ident when rangeContainsPos ident.idRange pos -> + found <- true + | _ -> () + if found then Some range else None + | _ -> + None + }) + result.IsSome /// Get declared items and the selected item at the specified location member _.GetNavigationItemsImpl() = ErrorScope.Protect range0 (fun () -> match input with - | Some (ParsedInput.ImplFile _ as p) -> + | ParsedInput.ImplFile _ as p -> Navigation.getNavigation p - | Some (ParsedInput.SigFile _) -> - Navigation.empty - | _ -> + | ParsedInput.SigFile _ -> Navigation.empty) (fun err -> Trace.TraceInformation(sprintf "FCS: recovering from error in GetNavigationItemsImpl: '%s'" err) @@ -685,7 +649,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput let walkImplFile (modules: SynModuleOrNamespace list) = List.collect walkModule modules match input with - | Some (ParsedInput.ImplFile (ParsedImplFileInput (modules = modules))) -> walkImplFile modules + | ParsedInput.ImplFile (ParsedImplFileInput (modules = modules)) -> walkImplFile modules | _ -> [] ErrorScope.Protect range0 @@ -717,11 +681,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput /// When these files appear or disappear the configuration for the current project is invalidated. member _.DependencyFiles = dependencyFiles - member _.FileName = - match input with - | Some (ParsedInput.ImplFile (ParsedImplFileInput (fileName = modname))) - | Some (ParsedInput.SigFile (ParsedSigFileInput (fileName = modname))) -> modname - | _ -> "" + member _.FileName = input.FileName // Get items for the navigation drop down bar member scope.GetNavigationItems() = diff --git a/src/fsharp/service/FSharpParseFileResults.fsi b/src/fsharp/service/FSharpParseFileResults.fsi index 8385e82ec35..310bb02fcbe 100644 --- a/src/fsharp/service/FSharpParseFileResults.fsi +++ b/src/fsharp/service/FSharpParseFileResults.fsi @@ -12,7 +12,7 @@ open FSharp.Compiler.Text type public FSharpParseFileResults = /// The syntax tree resulting from the parse - member ParseTree: ParsedInput option + member ParseTree: ParsedInput /// Attempts to find the range of the name of the nearest outer binding that contains a given position. member TryRangeOfNameOfNearestOuterBindingContainingPos: pos: pos -> range option @@ -70,5 +70,5 @@ type public FSharpParseFileResults = /// Indicates if any errors occurred during the parse member ParseHadErrors: bool - internal new: diagnostics: FSharpDiagnostic[] * input: ParsedInput option * parseHadErrors: bool * dependencyFiles: string[] -> FSharpParseFileResults + internal new: diagnostics: FSharpDiagnostic[] * input: ParsedInput * parseHadErrors: bool * dependencyFiles: string[] -> FSharpParseFileResults diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 3bb1c330818..ea9573d82f7 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -9,6 +9,7 @@ open System.IO open System.Runtime.InteropServices open System.Threading open Internal.Utilities.Library +open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.IL @@ -113,23 +114,13 @@ module IncrementalBuildSyntaxTree = let canSkip = sigNameOpt.IsSome && FSharpImplFileSuffixes |> List.exists (Filename.checkSuffix lower) let input = if canSkip then - ParsedInput.ImplFile( - ParsedImplFileInput( - filename, - false, - sigNameOpt.Value, - [], - [], - [], - isLastCompiland - ) - ) |> Some + EmptyParsedInput(filename, isLastCompiland) else ParseOneInputFile(tcConfig, lexResourceManager, [], filename, isLastCompiland, errorLogger, (*retryLocked*)true) fileParsed.Trigger filename - let res = input, sourceRange, filename, errorLogger.GetErrors () + let res = input, sourceRange, filename, errorLogger.GetDiagnostics() // If we do not skip parsing the file, then we can cache the real result. if not canSkip then weakCache <- Some(WeakReference<_>(res)) @@ -180,7 +171,7 @@ type TcInfo = /// Accumulated results of type checking. Optional data that isn't needed to type-check a file, but needed for more information for in tooling. [] -type TcInfoOptional = +type TcInfoExtras = { /// Accumulated resolutions, last file first tcResolutionsRev: TcResolutions list @@ -208,9 +199,9 @@ type TcInfoOptional = [] type TcInfoState = | PartialState of TcInfo - | FullState of TcInfo * TcInfoOptional + | FullState of TcInfo * TcInfoExtras - member this.Partial = + member this.TcInfo = match this with | PartialState tcInfo -> tcInfo | FullState(tcInfo, _) -> tcInfo @@ -227,17 +218,18 @@ type BoundModel private (tcConfig: TcConfig, beforeFileChecked: Event, fileChecked: Event, prevTcInfo: TcInfo, - prevTcInfoOptional: Eventually, + prevTcInfoExtras: (unit -> Eventually), syntaxTreeOpt: SyntaxTree option, - lazyTcInfoState: TcInfoState option ref) = + tcInfoStateOpt: TcInfoState option) = + let mutable lazyTcInfoState = tcInfoStateOpt let gate = obj() let defaultTypeCheck () = eventually { - match prevTcInfoOptional with - | Eventually.Done(Some prevTcInfoOptional) -> - return FullState(prevTcInfo, prevTcInfoOptional) + match prevTcInfoExtras() with + | Eventually.Done(Some prevTcInfoExtras) -> + return FullState(prevTcInfo, prevTcInfoExtras) | _ -> return PartialState prevTcInfo } @@ -263,13 +255,13 @@ type BoundModel private (tcConfig: TcConfig, member this.Invalidate() = lock gate (fun () -> let hasSig = this.BackingSignature.IsSome - match !lazyTcInfoState with + match lazyTcInfoState with // If partial checking is enabled and we have a backing sig file, then do nothing. The partial state contains the sig state. | Some(PartialState _) when enablePartialTypeChecking && hasSig -> () // If partial checking is enabled and we have a backing sig file, then use the partial state. The partial state contains the sig state. - | Some(FullState(tcInfo, _)) when enablePartialTypeChecking && hasSig -> lazyTcInfoState := Some(PartialState tcInfo) + | Some(FullState(tcInfo, _)) when enablePartialTypeChecking && hasSig -> lazyTcInfoState <- Some(PartialState tcInfo) | _ -> - lazyTcInfoState := None + lazyTcInfoState <- None // Always invalidate the syntax tree cache. syntaxTreeOpt @@ -283,31 +275,32 @@ type BoundModel private (tcConfig: TcConfig, else false let mustCheck = - match !lazyTcInfoState, partialCheck with + match lazyTcInfoState, partialCheck with | None, _ -> true | Some(PartialState _), false -> true | _ -> false - match !lazyTcInfoState with + match lazyTcInfoState with | Some tcInfoState when not mustCheck -> tcInfoState |> Eventually.Done | _ -> - lazyTcInfoState := None + lazyTcInfoState <- None eventually { let! tcInfoState = this.TypeCheck(partialCheck) - lazyTcInfoState := Some tcInfoState + lazyTcInfoState <- Some tcInfoState return tcInfoState } + member this.TryOptionalExtras() = + eventually { + let! prevState = this.GetState(false) + match prevState with + | FullState(_, prevTcInfoExtras) -> return Some prevTcInfoExtras + | _ -> return None + } + member this.Next(syntaxTree) = eventually { let! prevState = this.GetState(true) - let lazyPrevTcInfoOptional = - eventually { - let! prevState = this.GetState(false) - match prevState with - | FullState(_, prevTcInfoOptional) -> return Some prevTcInfoOptional - | _ -> return None - } return BoundModel( tcConfig, @@ -321,21 +314,21 @@ type BoundModel private (tcConfig: TcConfig, enablePartialTypeChecking, beforeFileChecked, fileChecked, - prevState.Partial, - lazyPrevTcInfoOptional, + prevState.TcInfo, + (fun () -> this.TryOptionalExtras()), Some syntaxTree, - ref None) + None) } member this.Finish(finalTcErrorsRev, finalTopAttribs) = eventually { let! state = this.GetState(true) - let finishTcInfo = { state.Partial with tcErrorsRev = finalTcErrorsRev; topAttribs = finalTopAttribs } + let finishTcInfo = { state.TcInfo with tcErrorsRev = finalTcErrorsRev; topAttribs = finalTopAttribs } let finishState = match state with | PartialState(_) -> PartialState(finishTcInfo) - | FullState(_, tcInfoOptional) -> FullState(finishTcInfo, tcInfoOptional) + | FullState(_, tcInfoExtras) -> FullState(finishTcInfo, tcInfoExtras) return BoundModel( @@ -351,30 +344,30 @@ type BoundModel private (tcConfig: TcConfig, beforeFileChecked, fileChecked, prevTcInfo, - prevTcInfoOptional, + prevTcInfoExtras, syntaxTreeOpt, - ref (Some finishState)) + Some finishState) } member this.TcInfo = eventually { let! state = this.GetState(true) - return state.Partial + return state.TcInfo } member this.TryTcInfo = - match !lazyTcInfoState with + match lazyTcInfoState with | Some(state) -> match state with | FullState(tcInfo, _) | PartialState(tcInfo) -> Some tcInfo | _ -> None - member this.TcInfoWithOptional = + member this.TcInfoWithExtras = eventually { let! state = this.GetState(false) match state with - | FullState(tcInfo, tcInfoOptional) -> return tcInfo, tcInfoOptional + | FullState(tcInfo, tcInfoExtras) -> return tcInfo, tcInfoExtras | PartialState tcInfo -> return tcInfo, @@ -389,7 +382,7 @@ type BoundModel private (tcConfig: TcConfig, } member private this.TypeCheck (partialCheck: bool) = - match partialCheck, !lazyTcInfoState with + match partialCheck, lazyTcInfoState with | true, Some (PartialState _ as state) | true, Some (FullState _ as state) -> state |> Eventually.Done | false, Some (FullState _ as state) -> state |> Eventually.Done @@ -405,7 +398,7 @@ type BoundModel private (tcConfig: TcConfig, else None match syntaxTree.Parse sigNameOpt with - | Some input, _sourceRange, filename, parseErrors -> + | input, _sourceRange, filename, parseErrors -> IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBETypechecked filename) let capturingErrorLogger = CompilationErrorLogger("TypeCheck", tcConfig.errorSeverityOptions) let errorLogger = GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput input, capturingErrorLogger) @@ -435,7 +428,7 @@ type BoundModel private (tcConfig: TcConfig, Logger.LogBlockMessageStop filename LogCompilerFunctionId.IncrementalBuild_TypeCheck fileChecked.Trigger filename - let newErrors = Array.append parseErrors (capturingErrorLogger.GetErrors()) + let newErrors = Array.append parseErrors (capturingErrorLogger.GetDiagnostics()) let tcEnvAtEndOfFile = if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls @@ -459,7 +452,7 @@ type BoundModel private (tcConfig: TcConfig, if partialCheck then return PartialState tcInfo else - match! prevTcInfoOptional with + match! prevTcInfoExtras() with | None -> return PartialState tcInfo | Some prevTcInfoOptional -> // Build symbol keys @@ -488,7 +481,7 @@ type BoundModel private (tcConfig: TcConfig, else None, None - let tcInfoOptional = + let tcInfoExtras = { /// Only keep the typed interface files when doing a "full" build for fsc.exe, otherwise just throw them away latestImplFile = if keepAssemblyContents then implFile else None @@ -499,7 +492,7 @@ type BoundModel private (tcConfig: TcConfig, semanticClassificationKeyStore = semanticClassification } - return FullState(tcInfo, tcInfoOptional) + return FullState(tcInfo, tcInfoExtras) } @@ -517,8 +510,6 @@ type BoundModel private (tcConfig: TcConfig, use unwind = new CompilationGlobalsScope (errorLogger, BuildPhase.TypeCheck) f ctok) return! timeSlicedComputation - | _ -> - return! defaultTypeCheck () } static member Create(tcConfig: TcConfig, @@ -531,7 +522,7 @@ type BoundModel private (tcConfig: TcConfig, beforeFileChecked: Event, fileChecked: Event, prevTcInfo: TcInfo, - prevTcInfoOptional: Eventually, + prevTcInfoExtras: (unit -> Eventually), syntaxTreeOpt: SyntaxTree option) = BoundModel(tcConfig, tcGlobals, tcImports, keepAssemblyContents, keepAllBackgroundResolutions, @@ -541,9 +532,9 @@ type BoundModel private (tcConfig: TcConfig, beforeFileChecked, fileChecked, prevTcInfo, - prevTcInfoOptional, + prevTcInfoExtras, syntaxTreeOpt, - ref None) + None) /// Global service state type FrameworkImportsCacheKey = (*resolvedpath*)string list * string * (*TargetFrameworkDirectories*)string list * (*fsharpBinaries*)string * (*langVersion*)decimal @@ -596,7 +587,7 @@ type FrameworkImportsCache(size) = /// Represents the interim state of checking an assembly [] -type PartialCheckResults private (boundModel: BoundModel, timeStamp: DateTime) = +type PartialCheckResults (boundModel: BoundModel, timeStamp: DateTime) = let eval ctok (work: Eventually<'T>) = match work with @@ -604,28 +595,27 @@ type PartialCheckResults private (boundModel: BoundModel, timeStamp: DateTime) = | _ -> Eventually.force ctok work member _.TcImports = boundModel.TcImports + member _.TcGlobals = boundModel.TcGlobals + member _.TcConfig = boundModel.TcConfig member _.TimeStamp = timeStamp - member _.TcInfo ctok = boundModel.TcInfo |> eval ctok - member _.TryTcInfo = boundModel.TryTcInfo - member _.TcInfoWithOptional ctok = boundModel.TcInfoWithOptional |> eval ctok + member _.GetTcInfo ctok = boundModel.TcInfo |> eval ctok + + member _.GetTcInfoWithExtras ctok = boundModel.TcInfoWithExtras |> eval ctok member _.TryGetItemKeyStore ctok = - let _, info = boundModel.TcInfoWithOptional |> eval ctok + let _, info = boundModel.TcInfoWithExtras |> eval ctok info.itemKeyStore member _.GetSemanticClassification ctok = - let _, info = boundModel.TcInfoWithOptional |> eval ctok + let _, info = boundModel.TcInfoWithExtras |> eval ctok info.semanticClassificationKeyStore - static member Create (boundModel: BoundModel, timestamp) = - PartialCheckResults(boundModel, timestamp) - [] module Utilities = let TryFindFSharpStringAttribute tcGlobals attribSpec attribs = @@ -644,7 +634,7 @@ type RawFSharpAssemblyDataBackedByLanguageService (tcConfig, tcGlobals, tcState: let exportRemapping = MakeExportRemapping generatedCcu generatedCcu.Contents let sigData = - let _sigDataAttributes, sigDataResources = Driver.EncodeSignatureData(tcConfig, tcGlobals, exportRemapping, generatedCcu, outfile, true) + let _sigDataAttributes, sigDataResources = EncodeSignatureData(tcConfig, tcGlobals, exportRemapping, generatedCcu, outfile, true) [ for r in sigDataResources do let ccuName = GetSignatureDataResourceName r yield (ccuName, (fun () -> r.GetBytes())) ] @@ -680,11 +670,23 @@ type IncrementalBuilderState = } /// Manages an incremental build graph for the build of a single F# project -type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInputs, nonFrameworkResolutions, unresolvedReferences, tcConfig: TcConfig, projectDirectory, outfile, - assemblyName, niceNameGen: NiceNameGenerator, lexResourceManager, - sourceFiles, loadClosureOpt: LoadClosure option, - keepAssemblyContents, keepAllBackgroundResolutions, - maxTimeShareMilliseconds, keepAllBackgroundSymbolUses, +type IncrementalBuilder(tcGlobals, + frameworkTcImports, + nonFrameworkAssemblyInputs, + nonFrameworkResolutions, + unresolvedReferences, + tcConfig: TcConfig, + projectDirectory, + outfile, + assemblyName, + niceNameGen: NiceNameGenerator, + lexResourceManager, + sourceFiles, + loadClosureOpt: LoadClosure option, + keepAssemblyContents, + keepAllBackgroundResolutions, + maxTimeShareMilliseconds, + keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking, dependencyProviderOpt: DependencyProvider option) = @@ -697,7 +699,6 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput #if !NO_EXTENSIONTYPING let importsInvalidatedByTypeProvider = new Event() #endif - let mutable currentTcImportsOpt = None let defaultPartialTypeChecking = enablePartialTypeChecking // Check for the existence of loaded sources and prepend them to the sources list if present. @@ -780,7 +781,6 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput | true, tg -> tg.Trigger msg | _ -> ())) #endif - currentTcImportsOpt <- Some tcImports return tcImports with e -> System.Diagnostics.Debug.Assert(false, sprintf "Could not BuildAllReferencedDllTcImports %A" e) @@ -795,10 +795,9 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput | None -> () | Some loadClosure -> for inp in loadClosure.Inputs do - for (err, isError) in inp.MetaCommandDiagnostics do - yield err, (if isError then FSharpDiagnosticSeverity.Error else FSharpDiagnosticSeverity.Warning) ] + yield! inp.MetaCommandDiagnostics ] - let initialErrors = Array.append (Array.ofList loadClosureErrors) (errorLogger.GetErrors()) + let initialErrors = Array.append (Array.ofList loadClosureErrors) (errorLogger.GetDiagnostics()) let tcInfo = { tcState=tcState @@ -810,7 +809,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput tcDependencyFiles = basicDependencies sigNameOpt = None } - let tcInfoOptional = + let tcInfoExtras = { tcResolutionsRev=[] tcSymbolUsesRev=[] @@ -830,7 +829,11 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, defaultPartialTypeChecking, - beforeFileChecked, fileChecked, tcInfo, Eventually.Done (Some tcInfoOptional), None) } + beforeFileChecked, + fileChecked, + tcInfo, + (fun () -> Eventually.Done (Some tcInfoExtras)), + None) } /// Type check all files. let TypeCheckTask ctok enablePartialTypeChecking (prevBoundModel: BoundModel) syntaxTree: Eventually = @@ -867,8 +870,8 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput let tcInfo = boundModel.TcInfo |> Eventually.force ctok tcInfo, None else - let tcInfo, tcInfoOptional = boundModel.TcInfoWithOptional |> Eventually.force ctok - tcInfo, tcInfoOptional.latestImplFile + let tcInfo, tcInfoExtras = boundModel.TcInfoWithExtras |> Eventually.force ctok + tcInfo, tcInfoExtras.latestImplFile tcInfo.tcEnvAtEndOfFile, defaultArg tcInfo.topAttribs EmptyTopAttrs, latestImplFile, tcInfo.latestCcuSigForFile) TypeCheckMultipleInputsFinish (results, finalInfo.tcState) @@ -927,7 +930,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput errorRecoveryNoRange e mkSimpleAssemblyRef assemblyName, None, None - let finalBoundModelWithErrors = finalBoundModel.Finish((errorLogger.GetErrors() :: finalInfo.tcErrorsRev), Some topAttrs) |> Eventually.force ctok + let finalBoundModelWithErrors = finalBoundModel.Finish((errorLogger.GetDiagnostics() :: finalInfo.tcErrorsRev), Some topAttrs) |> Eventually.force ctok return ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt, finalBoundModelWithErrors } @@ -1204,8 +1207,6 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput member _.ImportsInvalidatedByTypeProvider = importsInvalidatedByTypeProvider.Publish #endif - member _.TryGetCurrentTcImports () = currentTcImportsOpt - member _.AllDependenciesDeprecated = allDependencies member _.Step (ctok: CompilationThreadToken) = @@ -1225,7 +1226,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput let result = tryGetBeforeSlot currentState slotOfFile match result with - | Some (boundModel, timestamp) -> Some (PartialCheckResults.Create (boundModel, timestamp)) + | Some (boundModel, timestamp) -> Some (PartialCheckResults (boundModel, timestamp)) | _ -> None @@ -1243,7 +1244,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput let slotOfFile = builder.GetSlotOfFileName filename match tryGetBeforeSlot state slotOfFile with - | Some(boundModel, timestamp) -> PartialCheckResults.Create(boundModel, timestamp) |> Some + | Some(boundModel, timestamp) -> PartialCheckResults(boundModel, timestamp) |> Some | _ -> None member private _.GetCheckResultsBeforeSlotInProject (ctok: CompilationThreadToken, slotOfFile, enablePartialTypeChecking) = @@ -1252,7 +1253,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput let! state, result = eval { currentState with enablePartialTypeChecking = enablePartialTypeChecking } cache ctok (slotOfFile - 1) setCurrentState ctok { state with enablePartialTypeChecking = defaultPartialTypeChecking } match result with - | Some (boundModel, timestamp) -> return PartialCheckResults.Create (boundModel, timestamp) + | Some (boundModel, timestamp) -> return PartialCheckResults(boundModel, timestamp) | None -> return! failwith "Build was not evaluated, expected the results to be ready after 'Eval' (GetCheckResultsBeforeSlotInProject)." } @@ -1271,7 +1272,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput cancellable { let slotOfFile = builder.GetSlotOfFileName filename + 1 let! result = builder.GetCheckResultsBeforeSlotInProject(ctok, slotOfFile, false) - result.TcInfoWithOptional ctok |> ignore // Make sure we forcefully evaluate the info + result.GetTcInfoWithExtras ctok |> ignore // Make sure we forcefully evaluate the info return result } @@ -1286,7 +1287,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput setCurrentState ctok { state with enablePartialTypeChecking = defaultPartialTypeChecking } match result with | Some ((ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt, boundModel), timestamp) -> - return PartialCheckResults.Create (boundModel, timestamp), ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt + return PartialCheckResults (boundModel, timestamp), ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt | None -> let msg = "Build was not evaluated, expected the results to be ready after 'tryGetFinalized')." return! failwith msg @@ -1299,7 +1300,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput cancellable { let! result = builder.GetCheckResultsAndImplementationsForProject(ctok, false) let results, _, _, _ = result - results.TcInfoWithOptional ctok |> ignore // Make sure we forcefully evaluate the info + results.GetTcInfoWithExtras ctok |> ignore // Make sure we forcefully evaluate the info return result } @@ -1459,7 +1460,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput // included in these references. let! (tcGlobals, frameworkTcImports, nonFrameworkResolutions, unresolvedReferences) = frameworkTcImportsCache.Get(ctok, tcConfig) - // Note we are not calling errorLogger.GetErrors() anywhere for this task. + // Note we are not calling errorLogger.GetDiagnostics() anywhere for this task. // This is ok because not much can actually go wrong here. let errorOptions = tcConfig.errorSeverityOptions let errorLogger = CompilationErrorLogger("nonFrameworkAssemblyInputs", errorOptions) @@ -1471,7 +1472,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput // // This operation is done when constructing the builder itself, rather than as an incremental task. let nonFrameworkAssemblyInputs = - // Note we are not calling errorLogger.GetErrors() anywhere for this task. + // Note we are not calling errorLogger.GetDiagnostics() anywhere for this task. // This is ok because not much can actually go wrong here. let errorLogger = CompilationErrorLogger("nonFrameworkAssemblyInputs", errorOptions) // Return the disposable object that cleans up @@ -1485,10 +1486,19 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput yield Choice2Of2 pr, (fun (cache: TimeStampCache) -> cache.GetProjectReferenceTimeStamp (pr)) ] let builder = - new IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInputs, - nonFrameworkResolutions, unresolvedReferences, - tcConfig, projectDirectory, outfile, assemblyName, niceNameGen, - resourceManager, sourceFilesNew, loadClosureOpt, + new IncrementalBuilder(tcGlobals, + frameworkTcImports, + nonFrameworkAssemblyInputs, + nonFrameworkResolutions, + unresolvedReferences, + tcConfig, + projectDirectory, + outfile, + assemblyName, + niceNameGen, + resourceManager, + sourceFilesNew, + loadClosureOpt, keepAssemblyContents, keepAllBackgroundResolutions, maxTimeShareMilliseconds, @@ -1508,10 +1518,10 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput let errorSeverityOptions = builder.TcConfig.errorSeverityOptions let errorLogger = CompilationErrorLogger("IncrementalBuilderCreation", errorSeverityOptions) delayedLogger.CommitDelayedDiagnostics errorLogger - errorLogger.GetErrors() |> Array.map (fun (d, severity) -> d, severity = FSharpDiagnosticSeverity.Error) + errorLogger.GetDiagnostics() | _ -> Array.ofList delayedLogger.Diagnostics - |> Array.map (fun (d, isError) -> FSharpDiagnostic.CreateFromException(d, isError, range.Zero, suggestNamesForErrors)) + |> Array.map (fun (d, severity) -> FSharpDiagnostic.CreateFromException(d, severity, range.Zero, suggestNamesForErrors)) return builderOpt, diagnostics } diff --git a/src/fsharp/service/IncrementalBuild.fsi b/src/fsharp/service/IncrementalBuild.fsi index 60d73de2c2c..fd6774aa032 100755 --- a/src/fsharp/service/IncrementalBuild.fsi +++ b/src/fsharp/service/IncrementalBuild.fsi @@ -69,7 +69,7 @@ type internal TcInfo = /// Accumulated results of type checking. Optional data that isn't needed to type-check a file, but needed for more information for in tooling. [] -type internal TcInfoOptional = +type internal TcInfoExtras = { /// Accumulated resolutions, last file first tcResolutionsRev: TcResolutions list @@ -104,14 +104,18 @@ type internal PartialCheckResults = member TimeStamp: DateTime - member TcInfo: CompilationThreadToken -> TcInfo - member TryTcInfo: TcInfo option + /// Compute the "TcInfo" part of the results. If `enablePartialTypeChecking` is false then + /// extras will also be available. + member GetTcInfo: CompilationThreadToken -> TcInfo + + /// Compute both the "TcInfo" and "TcInfoExtras" parts of the results. /// Can cause a second type-check if `enablePartialTypeChecking` is true in the checker. /// Only use when it's absolutely necessary to get rich information on a file. - member TcInfoWithOptional: CompilationThreadToken -> TcInfo * TcInfoOptional + member GetTcInfoWithExtras: CompilationThreadToken -> TcInfo * TcInfoExtras + /// Compute the "ItemKeyStore" parts of the results. /// Can cause a second type-check if `enablePartialTypeChecking` is true in the checker. /// Only use when it's absolutely necessary to get rich information on a file. member TryGetItemKeyStore: CompilationThreadToken -> ItemKeyStore option @@ -152,9 +156,6 @@ type internal IncrementalBuilder = member ImportsInvalidatedByTypeProvider : IEvent #endif - /// Tries to get the current successful TcImports. This is only used in testing. Do not use it for other stuff. - member TryGetCurrentTcImports : unit -> TcImports option - /// The list of files the build depends on member AllDependenciesDeprecated : string[] @@ -228,7 +229,7 @@ type internal IncrementalBuilder = /// Await the untyped parse results for a particular slot in the vector of parse results. /// /// This may be a marginally long-running operation (parses are relatively quick, only one file needs to be parsed) - member GetParseResultsForFile: filename:string -> ParsedInput option * range * string * (PhasedDiagnostic * FSharpDiagnosticSeverity)[] + member GetParseResultsForFile: filename:string -> ParsedInput * range * string * (PhasedDiagnostic * FSharpDiagnosticSeverity)[] /// Create the incremental builder static member TryCreateIncrementalBuilderForProjectOptions: diff --git a/src/fsharp/service/ServiceParsedInputOps.fs b/src/fsharp/service/ServiceParsedInputOps.fs index 502a920bac3..93cfd5b6558 100644 --- a/src/fsharp/service/ServiceParsedInputOps.fs +++ b/src/fsharp/service/ServiceParsedInputOps.fs @@ -193,10 +193,7 @@ module ParsedInput = let emptyStringSet = HashSet() - let GetRangeOfExprLeftOfDot(pos: pos, parsedInputOpt) = - match parsedInputOpt with - | None -> None - | Some parseTree -> + let GetRangeOfExprLeftOfDot(pos: pos, parsedInput) = let CheckLongIdent(longIdent: LongIdent) = // find the longest prefix before the "pos" dot let mutable r = (List.head longIdent).idRange @@ -207,7 +204,7 @@ module ParsedInput = couldBeBeforeFront <- false couldBeBeforeFront, r - SyntaxTraversal.Traverse(pos, parseTree, { new SyntaxVisitorBase<_>() with + SyntaxTraversal.Traverse(pos, parsedInput, { new SyntaxVisitorBase<_>() with member _.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = let expr = expr // fix debugger locals match expr with @@ -290,10 +287,7 @@ module ParsedInput = }) /// searches for the expression island suitable for the evaluation by the debugger - let TryFindExpressionIslandInPosition(pos: pos, parsedInputOpt) = - match parsedInputOpt with - | None -> None - | Some parseTree -> + let TryFindExpressionIslandInPosition(pos: pos, parsedInput) = let getLidParts (lid : LongIdent) = lid |> Seq.takeWhile (fun i -> posGeq pos i.idRange.Start) @@ -332,7 +326,7 @@ module ParsedInput = | _ -> defaultTraverse expr else None } - SyntaxTraversal.Traverse(pos, parseTree, walker) + SyntaxTraversal.Traverse(pos, parsedInput, walker) // Given a cursor position here: // f(x) . ident @@ -346,10 +340,7 @@ module ParsedInput = // ^ // would return None // TODO would be great to unify this with GetRangeOfExprLeftOfDot above, if possible, as they are similar - let TryFindExpressionASTLeftOfDotLeftOfCursor(pos, parsedInputOpt) = - match parsedInputOpt with - | None -> None - | Some parseTree -> + let TryFindExpressionASTLeftOfDotLeftOfCursor(pos, parsedInput) = let dive x = SyntaxTraversal.dive x let pick x = SyntaxTraversal.pick pos x let walker = @@ -441,7 +432,7 @@ module ParsedInput = Some (lhs.Range.End, false) | x -> x // we found the answer deeper somewhere in the lhs | _ -> defaultTraverse expr } - SyntaxTraversal.Traverse(pos, parseTree, walker) + SyntaxTraversal.Traverse(pos, parsedInput, walker) let GetEntityKind (pos: pos, parsedInput: ParsedInput) : EntityKind option = let (|ConstructorPats|) = function @@ -1158,7 +1149,7 @@ module ParsedInput = | SynArgPats.NamePatPairs(xs, _) -> List.map snd xs /// Returns all `Ident`s and `LongIdent`s found in an untyped AST. - let getLongIdents (parsedInput: ParsedInput option) : IDictionary = + let getLongIdents (parsedInput: ParsedInput) : IDictionary = let identsByEndPos = Dictionary() let addLongIdent (longIdent: LongIdent) = @@ -1497,14 +1488,14 @@ module ParsedInput = | _ -> () match parsedInput with - | Some (ParsedInput.ImplFile input) -> + | ParsedInput.ImplFile input -> walkImplFileInput input | _ -> () //debug "%A" idents upcast identsByEndPos let GetLongIdentAt parsedInput pos = - let idents = getLongIdents (Some parsedInput) + let idents = getLongIdents parsedInput match idents.TryGetValue pos with | true, idents -> Some idents | _ -> None diff --git a/src/fsharp/service/ServiceParsedInputOps.fsi b/src/fsharp/service/ServiceParsedInputOps.fsi index a807eb920ea..d0c36e03cc9 100644 --- a/src/fsharp/service/ServiceParsedInputOps.fsi +++ b/src/fsharp/service/ServiceParsedInputOps.fsi @@ -112,11 +112,11 @@ type public InsertionContextEntity = /// Operations querying the entire syntax tree module public ParsedInput = - val TryFindExpressionASTLeftOfDotLeftOfCursor: pos: pos * parsedInputOpt: ParsedInput option -> (pos * bool) option + val TryFindExpressionASTLeftOfDotLeftOfCursor: pos: pos * parsedInput: ParsedInput -> (pos * bool) option - val GetRangeOfExprLeftOfDot: pos: pos * parsedInputOpt: ParsedInput option -> range option + val GetRangeOfExprLeftOfDot: pos: pos * parsedInput: ParsedInput -> range option - val TryFindExpressionIslandInPosition: pos: pos * parsedInputOpt: ParsedInput option -> string option + val TryFindExpressionIslandInPosition: pos: pos * parsedInput: ParsedInput -> string option val TryGetCompletionContext: pos: pos * parsedInput: ParsedInput * lineStr: string -> CompletionContext option diff --git a/src/fsharp/service/ServiceXmlDocParser.fs b/src/fsharp/service/ServiceXmlDocParser.fs index 6a3e5688011..dfa65682314 100644 --- a/src/fsharp/service/ServiceXmlDocParser.fs +++ b/src/fsharp/service/ServiceXmlDocParser.fs @@ -40,7 +40,7 @@ module XmlDocParsing = | SynPat.InstanceMember _ | SynPat.FromParseError _ -> [] - let getXmlDocablesImpl(sourceText: ISourceText, input: ParsedInput option) = + let getXmlDocablesImpl(sourceText: ISourceText, input: ParsedInput) = let indentOf (lineNum: int) = let mutable i = 0 let line = sourceText.GetLineString(lineNum-1) // -1 because lineNum reported by xmldocs are 1-based, but array is 0-based @@ -151,12 +151,7 @@ module XmlDocParsing = | ParsedInput.SigFile _ -> [] // Get compiler options for the 'project' implied by a single script file - match input with - | Some input -> - getXmlDocablesInput input - | None -> - // Should not fail here, just in case - [] + getXmlDocablesInput input module XmlDocComment = let ws (s: string, pos) = diff --git a/src/fsharp/service/ServiceXmlDocParser.fsi b/src/fsharp/service/ServiceXmlDocParser.fsi index 33e1e100dbd..bf3ef76e2e4 100644 --- a/src/fsharp/service/ServiceXmlDocParser.fsi +++ b/src/fsharp/service/ServiceXmlDocParser.fsi @@ -17,5 +17,5 @@ module public XmlDocComment = module public XmlDocParser = /// Get the list of Xml documentation from current source code - val GetXmlDocables: ISourceText * input: ParsedInput option -> XmlDocable list + val GetXmlDocables: ISourceText * input: ParsedInput -> XmlDocable list \ No newline at end of file diff --git a/src/fsharp/service/service.fs b/src/fsharp/service/service.fs index 2e521fbc85f..6375fca5c04 100644 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -14,6 +14,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILBinaryReader +open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.CompilerImports @@ -22,7 +23,7 @@ open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics open FSharp.Compiler.Driver open FSharp.Compiler.ErrorLogger -open FSharp.Compiler.CodeAnalysis +open FSharp.Compiler.ParseAndCheckInputs open FSharp.Compiler.ScriptClosure open FSharp.Compiler.Symbols open FSharp.Compiler.Syntax @@ -42,53 +43,6 @@ module EnvMisc = let maxMBDefault = GetEnvInteger "FCS_MaxMB" 1000000 // a million MB = 1TB = disabled //let maxMBDefault = GetEnvInteger "FCS_maxMB" (if sizeof = 4 then 1700 else 3400) -type FSharpUnresolvedReferencesSet = FSharpUnresolvedReferencesSet of UnresolvedAssemblyReference list - -// NOTE: may be better just to move to optional arguments here -type FSharpProjectOptions = - { - ProjectFileName: string - ProjectId: string option - SourceFiles: string[] - OtherOptions: string[] - ReferencedProjects: (string * FSharpProjectOptions)[] - IsIncompleteTypeCheckEnvironment : bool - UseScriptResolutionRules : bool - LoadTime : System.DateTime - UnresolvedReferences : FSharpUnresolvedReferencesSet option - OriginalLoadReferences: (range * string * string) list - Stamp : int64 option - } - member x.ProjectOptions = x.OtherOptions - /// Whether the two parse options refer to the same project. - static member UseSameProject(options1,options2) = - match options1.ProjectId, options2.ProjectId with - | Some(projectId1), Some(projectId2) when not (String.IsNullOrWhiteSpace(projectId1)) && not (String.IsNullOrWhiteSpace(projectId2)) -> - projectId1 = projectId2 - | Some(_), Some(_) - | None, None -> options1.ProjectFileName = options2.ProjectFileName - | _ -> false - - /// Compare two options sets with respect to the parts of the options that are important to building. - static member AreSameForChecking(options1,options2) = - match options1.Stamp, options2.Stamp with - | Some x, Some y -> (x = y) - | _ -> - FSharpProjectOptions.UseSameProject(options1, options2) && - options1.SourceFiles = options2.SourceFiles && - options1.OtherOptions = options2.OtherOptions && - options1.UnresolvedReferences = options2.UnresolvedReferences && - options1.OriginalLoadReferences = options2.OriginalLoadReferences && - options1.ReferencedProjects.Length = options2.ReferencedProjects.Length && - Array.forall2 (fun (n1,a) (n2,b) -> - n1 = n2 && - FSharpProjectOptions.AreSameForChecking(a,b)) options1.ReferencedProjects options2.ReferencedProjects && - options1.LoadTime = options2.LoadTime - - /// Compute the project directory. - member po.ProjectDirectory = System.IO.Path.GetDirectoryName(po.ProjectFileName) - override this.ToString() = "FSharpProjectOptions(" + this.ProjectFileName + ")" - //---------------------------------------------------------------------------- // BackgroundCompiler // @@ -444,7 +398,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC static let mutable foregroundTypeCheckCount = 0 - member _.RecordTypeCheckFileInProjectResults(filename,options,parsingOptions,parseResults,fileVersion,priorTimeStamp,checkAnswer,sourceText) = + member _.RecordCheckFileInProjectResults(filename,options,parsingOptions,parseResults,fileVersion,priorTimeStamp,checkAnswer,sourceText) = match checkAnswer with | None | Some FSharpCheckFileAnswer.Aborted -> () @@ -467,13 +421,13 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC | Some res -> return res | None -> foregroundParseCount <- foregroundParseCount + 1 - let parseDiags, parseTreeOpt, anyErrors = ParseAndCheckFile.parseFile(sourceText, filename, options, userOpName, suggestNamesForErrors) - let res = FSharpParseFileResults(parseDiags, parseTreeOpt, anyErrors, options.SourceFiles) + let parseDiags, parseTree, anyErrors = ParseAndCheckFile.parseFile(sourceText, filename, options, userOpName, suggestNamesForErrors) + let res = FSharpParseFileResults(parseDiags, parseTree, anyErrors, options.SourceFiles) parseCacheLock.AcquireLock(fun ltok -> parseFileCache.Set(ltok, (filename, hash, options), res)) return res else - let parseDiags, parseTreeOpt, anyErrors = ParseAndCheckFile.parseFile(sourceText, filename, options, userOpName, false) - return FSharpParseFileResults(parseDiags, parseTreeOpt, anyErrors, options.SourceFiles) + let parseDiags, parseTree, anyErrors = ParseAndCheckFile.parseFile(sourceText, filename, options, userOpName, false) + return FSharpParseFileResults(parseDiags, parseTree, anyErrors, options.SourceFiles) } /// Fetch the parse information from the background compiler (which checks w.r.t. the FileSystem API) @@ -481,11 +435,13 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC async { let! builderOpt, creationDiags = getBuilder reactor (options, userOpName, "GetBackgroundParseResultsForFileInProject ", filename) match builderOpt with - | None -> return FSharpParseFileResults(creationDiags, None, true, [| |]) + | None -> + let parseTree = EmptyParsedInput(filename, (false, false)) + return FSharpParseFileResults(creationDiags, parseTree, true, [| |]) | Some builder -> - let parseTreeOpt,_,_,parseDiags = builder.GetParseResultsForFile (filename) + let parseTree,_,_,parseDiags = builder.GetParseResultsForFile (filename) let diagnostics = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (builder.TcConfig.errorSeverityOptions, false, filename, parseDiags, suggestNamesForErrors) |] - return FSharpParseFileResults(diagnostics = diagnostics, input = parseTreeOpt, parseHadErrors = false, dependencyFiles = builder.AllDependenciesDeprecated) + return FSharpParseFileResults(diagnostics = diagnostics, input = parseTree, parseHadErrors = false, dependencyFiles = builder.AllDependenciesDeprecated) } member _.GetCachedCheckFileResult(builder: IncrementalBuilder, filename, sourceText: ISourceText, options) = @@ -523,14 +479,8 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC options: FSharpProjectOptions, fileVersion: int, builder: IncrementalBuilder, - tcConfig, - tcGlobals, - tcImports, - tcDependencyFiles, - timeStamp, - prevTcState, - prevModuleNamesDict, - prevTcErrors, + tcPrior: PartialCheckResults, + tcInfo: TcInfo, creationDiags: FSharpDiagnostic[], userOpName: string) = @@ -549,6 +499,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC try // Get additional script #load closure information if applicable. // For scripts, this will have been recorded by GetProjectOptionsFromScript. + let tcConfig = tcPrior.TcConfig let loadClosure = scriptClosureCache.TryGet(AnyCallerThread, options) let! checkAnswer = FSharpCheckFileResults.CheckOneFile @@ -557,24 +508,25 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC fileName, options.ProjectFileName, tcConfig, - tcGlobals, - tcImports, - prevTcState, - prevModuleNamesDict, + tcPrior.TcGlobals, + tcPrior.TcImports, + tcInfo.tcState, + tcInfo.moduleNamesDict, loadClosure, - prevTcErrors, + tcInfo.TcErrors, reactorOps, userOpName, options.IsIncompleteTypeCheckEnvironment, + options, builder, - Array.ofList tcDependencyFiles, + Array.ofList tcInfo.tcDependencyFiles, creationDiags, parseResults.Diagnostics, keepAssemblyContents, suggestNamesForErrors) let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, Array.ofList builder.SourceFiles, options.UseScriptResolutionRules) reactor.SetPreferredUILang tcConfig.preferredUiLang - bc.RecordTypeCheckFileInProjectResults(fileName, options, parsingOptions, parseResults, fileVersion, timeStamp, Some checkAnswer, sourceText.GetHashCode()) + bc.RecordCheckFileInProjectResults(fileName, options, parsingOptions, parseResults, fileVersion, tcPrior.TimeStamp, Some checkAnswer, sourceText.GetHashCode()) return checkAnswer finally let dummy = ref () @@ -624,7 +576,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC match tcPrior with | Some(tcPrior, tcInfo) -> - let! checkResults = bc.CheckOneFileImpl(parseResults, sourceText, filename, options, fileVersion, builder, tcPrior.TcConfig, tcPrior.TcGlobals, tcPrior.TcImports, tcInfo.tcDependencyFiles, tcPrior.TimeStamp, tcInfo.tcState, tcInfo.moduleNamesDict, tcInfo.TcErrors, creationDiags, userOpName) + let! checkResults = bc.CheckOneFileImpl(parseResults, sourceText, filename, options, fileVersion, builder, tcPrior, tcInfo, creationDiags, userOpName) return Some checkResults | None -> return None // the incremental builder was not up to date finally @@ -659,9 +611,9 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC execWithReactorAsync <| fun ctok -> cancellable { let! tcPrior = builder.GetCheckResultsBeforeFileInProject (ctok, filename) - return (tcPrior, tcPrior.TcInfo ctok) + return (tcPrior, tcPrior.GetTcInfo ctok) } - let! checkAnswer = bc.CheckOneFileImpl(parseResults, sourceText, filename, options, fileVersion, builder, tcPrior.TcConfig, tcPrior.TcGlobals, tcPrior.TcImports, tcInfo.tcDependencyFiles, tcPrior.TimeStamp, tcInfo.tcState, tcInfo.moduleNamesDict, tcInfo.TcErrors, creationDiags, userOpName) + let! checkAnswer = bc.CheckOneFileImpl(parseResults, sourceText, filename, options, fileVersion, builder, tcPrior, tcInfo, creationDiags, userOpName) return checkAnswer finally bc.ImplicitlyStartCheckProjectInBackground(options, userOpName) @@ -685,7 +637,8 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC | None -> Logger.LogBlockMessageStop (filename + strGuid + "-Failed_Aborted") LogCompilerFunctionId.Service_ParseAndCheckFileInProject - let parseResults = FSharpParseFileResults(creationDiags, None, true, [| |]) + let parseTree = EmptyParsedInput(filename, (false, false)) + let parseResults = FSharpParseFileResults(creationDiags, parseTree, true, [| |]) return (parseResults, FSharpCheckFileAnswer.Aborted) | Some builder -> @@ -707,15 +660,15 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC execWithReactorAsync <| fun ctok -> cancellable { let! tcPrior = builder.GetCheckResultsBeforeFileInProject (ctok, filename) - return (tcPrior, tcPrior.TcInfo ctok) + return (tcPrior, tcPrior.GetTcInfo ctok) } // Do the parsing. let parsingOptions = FSharpParsingOptions.FromTcConfig(builder.TcConfig, Array.ofList (builder.SourceFiles), options.UseScriptResolutionRules) reactor.SetPreferredUILang tcPrior.TcConfig.preferredUiLang - let parseDiags, parseTreeOpt, anyErrors = ParseAndCheckFile.parseFile (sourceText, filename, parsingOptions, userOpName, suggestNamesForErrors) - let parseResults = FSharpParseFileResults(parseDiags, parseTreeOpt, anyErrors, builder.AllDependenciesDeprecated) - let! checkResults = bc.CheckOneFileImpl(parseResults, sourceText, filename, options, fileVersion, builder, tcPrior.TcConfig, tcPrior.TcGlobals, tcPrior.TcImports, tcInfo.tcDependencyFiles, tcPrior.TimeStamp, tcInfo.tcState, tcInfo.moduleNamesDict, tcInfo.TcErrors, creationDiags, userOpName) + let parseDiags, parseTree, anyErrors = ParseAndCheckFile.parseFile (sourceText, filename, parsingOptions, userOpName, suggestNamesForErrors) + let parseResults = FSharpParseFileResults(parseDiags, parseTree, anyErrors, builder.AllDependenciesDeprecated) + let! checkResults = bc.CheckOneFileImpl(parseResults, sourceText, filename, options, fileVersion, builder, tcPrior, tcInfo, creationDiags, userOpName) Logger.LogBlockMessageStop (filename + strGuid + "-Successful") LogCompilerFunctionId.Service_ParseAndCheckFileInProject @@ -731,28 +684,29 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC let! builderOpt, creationDiags = getOrCreateBuilder (ctok, options, userOpName) match builderOpt with | None -> - let parseResults = FSharpParseFileResults(creationDiags, None, true, [| |]) - let typedResults = FSharpCheckFileResults.MakeEmpty(filename, creationDiags, keepAssemblyContents) + let parseTree = EmptyParsedInput(filename, (false, false)) + let parseResults = FSharpParseFileResults(creationDiags, parseTree, true, [| |]) + let typedResults = FSharpCheckFileResults.MakeEmpty(filename, creationDiags, true) return (parseResults, typedResults) | Some builder -> - let (parseTreeOpt, _, _, parseDiags) = builder.GetParseResultsForFile (filename) + let (parseTree, _, _, parseDiags) = builder.GetParseResultsForFile (filename) let! tcProj = builder.GetFullCheckResultsAfterFileInProject (ctok, filename) - let tcInfo, tcInfoOptional = tcProj.TcInfoWithOptional ctok + let tcInfo, tcInfoExtras = tcProj.GetTcInfoWithExtras ctok - let tcResolutionsRev = tcInfoOptional.tcResolutionsRev - let tcSymbolUsesRev = tcInfoOptional.tcSymbolUsesRev - let tcOpenDeclarationsRev = tcInfoOptional.tcOpenDeclarationsRev + let tcResolutionsRev = tcInfoExtras.tcResolutionsRev + let tcSymbolUsesRev = tcInfoExtras.tcSymbolUsesRev + let tcOpenDeclarationsRev = tcInfoExtras.tcOpenDeclarationsRev let latestCcuSigForFile = tcInfo.latestCcuSigForFile let tcState = tcInfo.tcState let tcEnvAtEnd = tcInfo.tcEnvAtEndOfFile - let latestImplementationFile = tcInfoOptional.latestImplFile + let latestImplementationFile = tcInfoExtras.latestImplFile let tcDependencyFiles = tcInfo.tcDependencyFiles let tcErrors = tcInfo.TcErrors let errorOptions = builder.TcConfig.errorSeverityOptions let parseDiags = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (errorOptions, false, filename, parseDiags, suggestNamesForErrors) |] let tcErrors = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (errorOptions, false, filename, tcErrors, suggestNamesForErrors) |] - let parseResults = FSharpParseFileResults(diagnostics = parseDiags, input = parseTreeOpt, parseHadErrors = false, dependencyFiles = builder.AllDependenciesDeprecated) + let parseResults = FSharpParseFileResults(diagnostics=parseDiags, input=parseTree, parseHadErrors=false, dependencyFiles=builder.AllDependenciesDeprecated) let loadClosure = scriptClosureCache.TryGet(AnyCallerThread, options) let typedResults = FSharpCheckFileResults.Make @@ -762,6 +716,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC tcProj.TcGlobals, options.IsIncompleteTypeCheckEnvironment, builder, + options, Array.ofList tcDependencyFiles, creationDiags, parseResults.Diagnostics, @@ -832,19 +787,29 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC let errorOptions = tcProj.TcConfig.errorSeverityOptions let fileName = TcGlobals.DummyFileNameForRangesWithoutASpecificLocation - let tcInfo, tcInfoOptional = tcProj.TcInfoWithOptional ctok + let tcInfo, tcInfoExtras = tcProj.GetTcInfoWithExtras ctok - let tcSymbolUses = tcInfoOptional.TcSymbolUses + let tcSymbolUses = tcInfoExtras.TcSymbolUses let topAttribs = tcInfo.topAttribs let tcState = tcInfo.tcState let tcEnvAtEnd = tcInfo.tcEnvAtEndOfFile let tcErrors = tcInfo.TcErrors let tcDependencyFiles = tcInfo.tcDependencyFiles - let errors = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (errorOptions, true, fileName, tcErrors, suggestNamesForErrors) |] - return FSharpCheckProjectResults (options.ProjectFileName, Some tcProj.TcConfig, keepAssemblyContents, errors, - Some(tcProj.TcGlobals, tcProj.TcImports, tcState.Ccu, tcState.CcuSig, - tcSymbolUses, topAttribs, tcAssemblyDataOpt, ilAssemRef, - tcEnvAtEnd.AccessRights, tcAssemblyExprOpt, Array.ofList tcDependencyFiles)) + let diagnostics = + [| yield! creationDiags; + yield! DiagnosticHelpers.CreateDiagnostics (errorOptions, true, fileName, tcErrors, suggestNamesForErrors) |] + let results = + FSharpCheckProjectResults + (options.ProjectFileName, + Some tcProj.TcConfig, + keepAssemblyContents, + diagnostics, + Some(tcProj.TcGlobals, tcProj.TcImports, tcState.Ccu, tcState.CcuSig, + tcSymbolUses, topAttribs, tcAssemblyDataOpt, ilAssemRef, + tcEnvAtEnd.AccessRights, tcAssemblyExprOpt, + Array.ofList tcDependencyFiles, + options)) + return results } member _.GetAssemblyData(options, ctok, userOpName) = @@ -1048,7 +1013,16 @@ type FSharpChecker(legacyReferenceResolver, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking) = - let backgroundCompiler = BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyContents, keepAllBackgroundResolutions, tryGetMetadataSnapshot, suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking) + let backgroundCompiler = + BackgroundCompiler(legacyReferenceResolver, + projectCacheSize, + keepAssemblyContents, + keepAllBackgroundResolutions, + tryGetMetadataSnapshot, + suggestNamesForErrors, + keepAllBackgroundSymbolUses, + enableBackgroundItemKeyStoreAndSemanticClassification, + enablePartialTypeChecking) static let globalInstance = lazy FSharpChecker.Create() @@ -1084,7 +1058,15 @@ type FSharpChecker(legacyReferenceResolver, if keepAssemblyContents && enablePartialTypeChecking then invalidArg "enablePartialTypeChecking" "'keepAssemblyContents' and 'enablePartialTypeChecking' cannot be both enabled." - new FSharpChecker(legacyReferenceResolver, projectCacheSizeReal,keepAssemblyContents, keepAllBackgroundResolutions, tryGetMetadataSnapshot, suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking) + FSharpChecker(legacyReferenceResolver, + projectCacheSizeReal, + keepAssemblyContents, + keepAllBackgroundResolutions, + tryGetMetadataSnapshot, + suggestNamesForErrors, + keepAllBackgroundSymbolUses, + enableBackgroundItemKeyStoreAndSemanticClassification, + enablePartialTypeChecking) member _.ReferenceResolver = legacyReferenceResolver diff --git a/src/fsharp/service/service.fsi b/src/fsharp/service/service.fsi index f646d0c1c1b..cf5725f18f5 100644 --- a/src/fsharp/service/service.fsi +++ b/src/fsharp/service/service.fsi @@ -15,53 +15,6 @@ open FSharp.Compiler.Syntax open FSharp.Compiler.Text open FSharp.Compiler.Tokenization -/// Unused in this API -type public FSharpUnresolvedReferencesSet - -/// A set of information describing a project or script build configuration. -type public FSharpProjectOptions = - { - // Note that this may not reduce to just the project directory, because there may be two projects in the same directory. - ProjectFileName: string - - /// This is the unique identifier for the project, it is case sensitive. If it's None, will key off of ProjectFileName in our caching. - ProjectId: string option - - /// The files in the project - SourceFiles: string[] - - /// Additional command line argument options for the project. These can include additional files and references. - OtherOptions: string[] - - /// The command line arguments for the other projects referenced by this project, indexed by the - /// exact text used in the "-r:" reference in FSharpProjectOptions. - ReferencedProjects: (string * FSharpProjectOptions)[] - - /// When true, the typechecking environment is known a priori to be incomplete, for - /// example when a .fs file is opened outside of a project. In this case, the number of error - /// messages reported is reduced. - IsIncompleteTypeCheckEnvironment: bool - - /// When true, use the reference resolution rules for scripts rather than the rules for compiler. - UseScriptResolutionRules: bool - - /// Timestamp of project/script load, used to differentiate between different instances of a project load. - /// This ensures that a complete reload of the project or script type checking - /// context occurs on project or script unload/reload. - LoadTime: DateTime - - /// Unused in this API and should be 'None' when used as user-specified input - UnresolvedReferences: FSharpUnresolvedReferencesSet option - - /// Unused in this API and should be '[]' when used as user-specified input - OriginalLoadReferences: (range * string * string) list - - /// An optional stamp to uniquely identify this set of options - /// If two sets of options both have stamps, then they are considered equal - /// if and only if the stamps are equal - Stamp: int64 option - } - [] /// Used to parse and check F# source code. type public FSharpChecker = diff --git a/src/fsharp/symbols/SymbolHelpers.fs b/src/fsharp/symbols/SymbolHelpers.fs index b9e1029c9f2..82e613a3e56 100644 --- a/src/fsharp/symbols/SymbolHelpers.fs +++ b/src/fsharp/symbols/SymbolHelpers.fs @@ -22,14 +22,7 @@ open FSharp.Compiler.Text open FSharp.Compiler.Text.Position open FSharp.Compiler.Text.Range -[] -type FSharpDiagnosticSeverity = - | Hidden - | Info - | Warning - | Error - -type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: string, subcategory: string, errorNum: int) = +type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: string, subcategory: string, errorNum: int, numberPrefix: string) = member _.Range = m member _.Severity = severity @@ -40,6 +33,10 @@ type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: str member _.ErrorNumber = errorNum + member _.ErrorNumberPrefix = numberPrefix + + member _.ErrorNumberText = numberPrefix + errorNum.ToString("0000") + member _.Start = m.Start member _.End = m.End @@ -56,11 +53,11 @@ type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: str member _.WithStart newStart = let m = mkFileIndexRange m.FileIndex newStart m.End - FSharpDiagnostic(m, severity, message, subcategory, errorNum) + FSharpDiagnostic(m, severity, message, subcategory, errorNum, numberPrefix) member _.WithEnd newEnd = let m = mkFileIndexRange m.FileIndex m.Start newEnd - FSharpDiagnostic(m, severity, message, subcategory, errorNum) + FSharpDiagnostic(m, severity, message, subcategory, errorNum, numberPrefix) override _.ToString() = let fileName = m.FileName @@ -70,16 +67,15 @@ type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: str sprintf "%s (%d,%d)-(%d,%d) %s %s %s" fileName s.Line (s.Column + 1) e.Line (e.Column + 1) subcategory severity message /// Decompose a warning or error into parts: position, severity, message, error number - static member CreateFromException(exn, isError, fallbackRange: range, suggestNames: bool) = + static member CreateFromException(exn, severity, fallbackRange: range, suggestNames: bool) = let m = match GetRangeOfDiagnostic exn with Some m -> m | None -> fallbackRange - let severity = if isError then FSharpDiagnosticSeverity.Error else FSharpDiagnosticSeverity.Warning let msg = bufs (fun buf -> OutputPhasedDiagnostic buf exn false suggestNames) let errorNum = GetDiagnosticNumber exn - FSharpDiagnostic(m, severity, msg, exn.Subcategory(), errorNum) + FSharpDiagnostic(m, severity, msg, exn.Subcategory(), errorNum, "FS") /// Decompose a warning or error into parts: position, severity, message, error number - static member CreateFromExceptionAndAdjustEof(exn, isError, fallbackRange: range, (linesCount: int, lastLength: int), suggestNames: bool) = - let r = FSharpDiagnostic.CreateFromException(exn, isError, fallbackRange, suggestNames) + static member CreateFromExceptionAndAdjustEof(exn, severity, fallbackRange: range, (linesCount: int, lastLength: int), suggestNames: bool) = + let r = FSharpDiagnostic.CreateFromException(exn, severity, fallbackRange, suggestNames) // Adjust to make sure that errors reported at Eof are shown at the linesCount let startline, schange = min (Line.toZ r.Range.StartLine, false) (linesCount, true) @@ -94,6 +90,11 @@ type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: str static member NormalizeErrorString(text) = ErrorLogger.NormalizeErrorString(text) + static member Create(severity: FSharpDiagnosticSeverity, message: string, number: int, range: range, ?numberPrefix: string, ?subcategory: string) = + let subcategory = defaultArg subcategory BuildPhaseSubcategory.TypeCheck + let numberPrefix = defaultArg numberPrefix "FS" + FSharpDiagnostic(range, severity, message, subcategory, number, numberPrefix) + /// Use to reset error and warning handlers [] type ErrorScope() = @@ -103,16 +104,19 @@ type ErrorScope() = let unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _oldLogger -> { new ErrorLogger("ErrorScope") with - member x.DiagnosticSink(exn, isError) = - let err = FSharpDiagnostic.CreateFromException(exn, isError, range.Zero, false) + member x.DiagnosticSink(exn, severity) = + let err = FSharpDiagnostic.CreateFromException(exn, severity, range.Zero, false) errors <- err :: errors - if isError && firstError.IsNone then + if severity = FSharpDiagnosticSeverity.Error && firstError.IsNone then firstError <- Some err.Message member x.ErrorCount = errors.Length }) member x.Errors = errors |> List.filter (fun error -> error.Severity = FSharpDiagnosticSeverity.Error) + member x.Warnings = errors |> List.filter (fun error -> error.Severity = FSharpDiagnosticSeverity.Warning) + member x.Diagnostics = errors + member x.TryGetFirstErrorText() = match x.Errors with | error :: _ -> Some error.Message @@ -162,8 +166,8 @@ type internal CompilationErrorLogger (debugName: string, options: FSharpDiagnost let mutable errorCount = 0 let diagnostics = new ResizeArray<_>() - override x.DiagnosticSink(exn, isError) = - if isError || ReportWarningAsError options exn then + override x.DiagnosticSink(exn, severity) = + if severity = FSharpDiagnosticSeverity.Error || ReportWarningAsError options exn then diagnostics.Add(exn, FSharpDiagnosticSeverity.Error) errorCount <- errorCount + 1 elif ReportWarning options exn then @@ -171,7 +175,7 @@ type internal CompilationErrorLogger (debugName: string, options: FSharpDiagnost override x.ErrorCount = errorCount - member x.GetErrors() = diagnostics.ToArray() + member x.GetDiagnostics() = diagnostics.ToArray() /// This represents the global state established as each task function runs as part of the build. @@ -188,14 +192,17 @@ type CompilationGlobalsScope(errorLogger: ErrorLogger, phase: BuildPhase) = module DiagnosticHelpers = - let ReportError (options: FSharpDiagnosticOptions, allErrors, mainInputFileName, fileInfo, (exn, sev), suggestNames) = - [ let isError = (sev = FSharpDiagnosticSeverity.Error) || ReportWarningAsError options exn - if (isError || ReportWarning options exn) then + let ReportDiagnostic (options: FSharpDiagnosticOptions, allErrors, mainInputFileName, fileInfo, (exn, severity), suggestNames) = + [ let severity = + if (severity = FSharpDiagnosticSeverity.Error) then severity + elif ReportWarningAsError options exn then FSharpDiagnosticSeverity.Error + else severity + if (severity = FSharpDiagnosticSeverity.Error || ReportWarning options exn) then let oneError exn = [ // We use the first line of the file as a fallbackRange for reporting unexpected errors. // Not ideal, but it's hard to see what else to do. let fallbackRange = rangeN mainInputFileName 1 - let ei = FSharpDiagnostic.CreateFromExceptionAndAdjustEof (exn, isError, fallbackRange, fileInfo, suggestNames) + let ei = FSharpDiagnostic.CreateFromExceptionAndAdjustEof (exn, severity, fallbackRange, fileInfo, suggestNames) let fileName = ei.Range.FileName if allErrors || fileName = mainInputFileName || fileName = TcGlobals.DummyFileNameForRangesWithoutASpecificLocation then yield ei ] @@ -207,8 +214,8 @@ module DiagnosticHelpers = let CreateDiagnostics (options, allErrors, mainInputFileName, errors, suggestNames) = let fileInfo = (Int32.MaxValue, Int32.MaxValue) - [| for (exn, isError) in errors do - yield! ReportError (options, allErrors, mainInputFileName, fileInfo, (exn, isError), suggestNames) |] + [| for (exn, severity) in errors do + yield! ReportDiagnostic (options, allErrors, mainInputFileName, fileInfo, (exn, severity), suggestNames) |] namespace FSharp.Compiler.Symbols diff --git a/src/fsharp/symbols/SymbolHelpers.fsi b/src/fsharp/symbols/SymbolHelpers.fsi index 798b072090c..8a9c547ca34 100755 --- a/src/fsharp/symbols/SymbolHelpers.fsi +++ b/src/fsharp/symbols/SymbolHelpers.fsi @@ -10,13 +10,6 @@ namespace FSharp.Compiler.Diagnostics open FSharp.Compiler.Text open FSharp.Compiler.ErrorLogger - [] - type public FSharpDiagnosticSeverity = - | Hidden - | Info - | Warning - | Error - /// Represents a diagnostic produced by the F# compiler [] type public FSharpDiagnostic = @@ -57,8 +50,18 @@ namespace FSharp.Compiler.Diagnostics /// Gets the number for the diagnostic member ErrorNumber: int - static member internal CreateFromExceptionAndAdjustEof: PhasedDiagnostic * isError: bool * range * lastPosInFile: (int*int) * suggestNames: bool -> FSharpDiagnostic - static member internal CreateFromException: PhasedDiagnostic * isError: bool * range * suggestNames: bool -> FSharpDiagnostic + /// Gets the number prefix for the diagnostic, usually "FS" but may differ for analyzers + member ErrorNumberPrefix: string + + /// Gets the full error number text e.g "FS0031" + member ErrorNumberText: string + + /// Creates a diagnostic, e.g. for reporting from an analyzer + static member Create: severity: FSharpDiagnosticSeverity * message: string * number: int * range: range * ?numberPrefix: string * ?subcategory: string -> FSharpDiagnostic + + static member internal CreateFromExceptionAndAdjustEof: PhasedDiagnostic * severity: FSharpDiagnosticSeverity * range * lastPosInFile: (int*int) * suggestNames: bool -> FSharpDiagnostic + + static member internal CreateFromException: PhasedDiagnostic * severity: FSharpDiagnosticSeverity * range * suggestNames: bool -> FSharpDiagnostic /// Newlines are recognized and replaced with (ASCII 29, the 'group separator'), /// which is decoded by the IDE with 'NewlineifyErrorString' back into newlines, so that multi-line errors can be displayed in QuickInfo @@ -83,11 +86,11 @@ namespace FSharp.Compiler.Diagnostics type internal CompilationErrorLogger = inherit ErrorLogger - /// Create the error logger + /// Create the diagnostics logger new: debugName:string * options: FSharpDiagnosticOptions -> CompilationErrorLogger - /// Get the captured errors - member GetErrors: unit -> (PhasedDiagnostic * FSharpDiagnosticSeverity)[] + /// Get the captured diagnostics + member GetDiagnostics: unit -> (PhasedDiagnostic * FSharpDiagnosticSeverity)[] /// This represents the global state established as each task function runs as part of the build. /// @@ -97,7 +100,7 @@ namespace FSharp.Compiler.Diagnostics interface IDisposable module internal DiagnosticHelpers = - val ReportError: FSharpDiagnosticOptions * allErrors: bool * mainInputFileName: string * fileInfo: (int * int) * (PhasedDiagnostic * FSharpDiagnosticSeverity) * suggestNames: bool -> FSharpDiagnostic list + val ReportDiagnostic: FSharpDiagnosticOptions * allErrors: bool * mainInputFileName: string * fileInfo: (int * int) * (PhasedDiagnostic * FSharpDiagnosticSeverity) * suggestNames: bool -> FSharpDiagnostic list val CreateDiagnostics: FSharpDiagnosticOptions * allErrors: bool * mainInputFileName: string * seq<(PhasedDiagnostic * FSharpDiagnosticSeverity)> * suggestNames: bool -> FSharpDiagnostic[] diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index 0839109f2e6..119b368ff25 100644 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -1915,11 +1915,11 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = match d with | P p -> [ [ for (ParamData(isParamArrayArg, isInArg, isOutArg, optArgInfo, _callerInfo, nmOpt, _reflArgInfo, pty)) in p.GetParamDatas(cenv.amap, range0) do - // INCOMPLETENESS: Attribs is empty here, so we can't look at attributes for - // either .NET or F# parameters - let argInfo: ArgReprInfo = { Name=nmOpt; Attribs= [] } - yield FSharpParameter(cenv, pty, argInfo, None, x.DeclarationLocationOpt, isParamArrayArg, isInArg, isOutArg, optArgInfo.IsOptional, false) ] - |> makeReadOnlyCollection ] + // INCOMPLETENESS: Attribs is empty here, so we can't look at attributes for + // either .NET or F# parameters + let argInfo: ArgReprInfo = { Name=nmOpt; Attribs= [] } + yield FSharpParameter(cenv, pty, argInfo, None, x.DeclarationLocationOpt, isParamArrayArg, isInArg, isOutArg, optArgInfo.IsOptional, false) ] + |> makeReadOnlyCollection ] |> makeReadOnlyCollection | E _ -> [] |> makeReadOnlyCollection diff --git a/src/fsharp/utils/CompilerLocationUtils.fs b/src/fsharp/utils/CompilerLocationUtils.fs index 04c27204330..a90e2ce103a 100644 --- a/src/fsharp/utils/CompilerLocationUtils.fs +++ b/src/fsharp/utils/CompilerLocationUtils.fs @@ -267,15 +267,15 @@ module internal FSharpEnvironment = yield Path.Combine(toolPath, protocol, netRuntime) ] - let rec searchToolPaths path compilerToolPaths = + let searchToolPath compilerToolPath = seq { - let searchToolPath path = - seq { - yield path - for toolPath in toolingCompatiblePaths() do - yield Path.Combine (path, toolPath) - } + yield compilerToolPath + for toolPath in toolingCompatiblePaths() do + yield Path.Combine (compilerToolPath, toolPath) + } + let rec searchToolPaths path compilerToolPaths = + seq { for toolPath in compilerToolPaths do yield! searchToolPath toolPath diff --git a/src/fsharp/utils/CompilerLocationUtils.fsi b/src/fsharp/utils/CompilerLocationUtils.fsi index c044f82f2ce..4a9ecbaf271 100644 --- a/src/fsharp/utils/CompilerLocationUtils.fsi +++ b/src/fsharp/utils/CompilerLocationUtils.fsi @@ -29,8 +29,7 @@ module internal FSharpEnvironment = val toolingCompatiblePaths: unit -> string list - val searchToolPaths: - path:string option -> compilerToolPaths:seq -> seq + val searchToolPaths: path:string option -> compilerToolPaths:seq -> seq val getTypeProviderAssembly: runTimeAssemblyFileName:string * diff --git a/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs b/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs index d129bade980..ad4eb78ab85 100644 --- a/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs +++ b/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs @@ -1488,9 +1488,9 @@ FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: Boolean get_ParseHadErrors( FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: FSharp.Compiler.Diagnostics.FSharpDiagnostic[] Diagnostics FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: FSharp.Compiler.Diagnostics.FSharpDiagnostic[] get_Diagnostics() FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: FSharp.Compiler.EditorServices.NavigationItems GetNavigationItems() +FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: FSharp.Compiler.Syntax.ParsedInput ParseTree +FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: FSharp.Compiler.Syntax.ParsedInput get_ParseTree() FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.EditorServices.ParameterLocations] FindParameterLocations(FSharp.Compiler.Text.Position) -FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.ParsedInput] ParseTree -FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.ParsedInput] get_ParseTree() FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] TryRangeOfExprInYieldOrReturn(FSharp.Compiler.Text.Position) FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] TryRangeOfFunctionOrMethodBeingApplied(FSharp.Compiler.Text.Position) FSharp.Compiler.CodeAnalysis.FSharpParseFileResults: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] TryRangeOfNameOfNearestOuterBindingContainingPos(FSharp.Compiler.Text.Position) @@ -1532,6 +1532,8 @@ FSharp.Compiler.CodeAnalysis.FSharpParsingOptions: System.String[] SourceFiles FSharp.Compiler.CodeAnalysis.FSharpParsingOptions: System.String[] get_SourceFiles() FSharp.Compiler.CodeAnalysis.FSharpParsingOptions: Void .ctor(System.String[], Microsoft.FSharp.Collections.FSharpList`1[System.String], FSharp.Compiler.Diagnostics.FSharpDiagnosticOptions, Boolean, Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Boolean, Boolean) FSharp.Compiler.CodeAnalysis.FSharpProjectContext +FSharp.Compiler.CodeAnalysis.FSharpProjectContext: FSharp.Compiler.CodeAnalysis.FSharpProjectOptions ProjectOptions +FSharp.Compiler.CodeAnalysis.FSharpProjectContext: FSharp.Compiler.CodeAnalysis.FSharpProjectOptions get_ProjectOptions() FSharp.Compiler.CodeAnalysis.FSharpProjectContext: FSharp.Compiler.Symbols.FSharpAccessibilityRights AccessibilityRights FSharp.Compiler.CodeAnalysis.FSharpProjectContext: FSharp.Compiler.Symbols.FSharpAccessibilityRights get_AccessibilityRights() FSharp.Compiler.CodeAnalysis.FSharpProjectContext: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Symbols.FSharpAssembly] GetReferencedAssemblies() @@ -1683,9 +1685,10 @@ FSharp.Compiler.DependencyManager.ResolvingErrorReport: Void .ctor(System.Object FSharp.Compiler.DependencyManager.ResolvingErrorReport: Void EndInvoke(System.IAsyncResult) FSharp.Compiler.DependencyManager.ResolvingErrorReport: Void Invoke(FSharp.Compiler.DependencyManager.ErrorReportType, Int32, System.String) FSharp.Compiler.Diagnostics.CompilerDiagnostics -FSharp.Compiler.Diagnostics.CompilerDiagnostics: System.String GetErrorMessage(FSharp.Compiler.Diagnostics.FSharpDiagnosticKind) FSharp.Compiler.Diagnostics.CompilerDiagnostics: System.Collections.Generic.IEnumerable`1[System.String] GetSuggestedNames(Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.FSharpFunc`2[System.String,Microsoft.FSharp.Core.Unit],Microsoft.FSharp.Core.Unit], System.String) +FSharp.Compiler.Diagnostics.CompilerDiagnostics: System.String GetErrorMessage(FSharp.Compiler.Diagnostics.FSharpDiagnosticKind) FSharp.Compiler.Diagnostics.FSharpDiagnostic +FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Diagnostics.FSharpDiagnostic Create(FSharp.Compiler.Diagnostics.FSharpDiagnosticSeverity, System.String, Int32, FSharp.Compiler.Text.Range, Microsoft.FSharp.Core.FSharpOption`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[System.String]) FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Diagnostics.FSharpDiagnosticSeverity Severity FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Diagnostics.FSharpDiagnosticSeverity get_Severity() FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Text.Position End @@ -1704,12 +1707,16 @@ FSharp.Compiler.Diagnostics.FSharpDiagnostic: Int32 get_EndLine() FSharp.Compiler.Diagnostics.FSharpDiagnostic: Int32 get_ErrorNumber() FSharp.Compiler.Diagnostics.FSharpDiagnostic: Int32 get_StartColumn() FSharp.Compiler.Diagnostics.FSharpDiagnostic: Int32 get_StartLine() +FSharp.Compiler.Diagnostics.FSharpDiagnostic: System.String ErrorNumberPrefix +FSharp.Compiler.Diagnostics.FSharpDiagnostic: System.String ErrorNumberText FSharp.Compiler.Diagnostics.FSharpDiagnostic: System.String FileName FSharp.Compiler.Diagnostics.FSharpDiagnostic: System.String Message FSharp.Compiler.Diagnostics.FSharpDiagnostic: System.String NewlineifyErrorString(System.String) FSharp.Compiler.Diagnostics.FSharpDiagnostic: System.String NormalizeErrorString(System.String) FSharp.Compiler.Diagnostics.FSharpDiagnostic: System.String Subcategory FSharp.Compiler.Diagnostics.FSharpDiagnostic: System.String ToString() +FSharp.Compiler.Diagnostics.FSharpDiagnostic: System.String get_ErrorNumberPrefix() +FSharp.Compiler.Diagnostics.FSharpDiagnostic: System.String get_ErrorNumberText() FSharp.Compiler.Diagnostics.FSharpDiagnostic: System.String get_FileName() FSharp.Compiler.Diagnostics.FSharpDiagnostic: System.String get_Message() FSharp.Compiler.Diagnostics.FSharpDiagnostic: System.String get_Subcategory() @@ -2161,7 +2168,6 @@ FSharp.Compiler.EditorServices.FindDeclExternalParam: Int32 CompareTo(System.Obj FSharp.Compiler.EditorServices.FindDeclExternalParam: Int32 GetHashCode() FSharp.Compiler.EditorServices.FindDeclExternalParam: Int32 GetHashCode(System.Collections.IEqualityComparer) FSharp.Compiler.EditorServices.FindDeclExternalParam: System.String ToString() -FSharp.Compiler.EditorServices.FindDeclExternalParamModule FSharp.Compiler.EditorServices.FindDeclExternalSymbol FSharp.Compiler.EditorServices.FindDeclExternalSymbol+Constructor: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.EditorServices.FindDeclExternalParam] args FSharp.Compiler.EditorServices.FindDeclExternalSymbol+Constructor: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.EditorServices.FindDeclExternalParam] get_args() @@ -2274,7 +2280,6 @@ FSharp.Compiler.EditorServices.FindDeclExternalType: Int32 GetHashCode(System.Co FSharp.Compiler.EditorServices.FindDeclExternalType: Int32 Tag FSharp.Compiler.EditorServices.FindDeclExternalType: Int32 get_Tag() FSharp.Compiler.EditorServices.FindDeclExternalType: System.String ToString() -FSharp.Compiler.EditorServices.FindDeclExternalTypeModule FSharp.Compiler.EditorServices.FindDeclFailureReason FSharp.Compiler.EditorServices.FindDeclFailureReason+ProvidedMember: System.String get_memberName() FSharp.Compiler.EditorServices.FindDeclFailureReason+ProvidedMember: System.String memberName @@ -2858,10 +2863,10 @@ FSharp.Compiler.EditorServices.ParsedInput: FSharp.Compiler.Text.Position Adjust FSharp.Compiler.EditorServices.ParsedInput: Microsoft.FSharp.Core.FSharpFunc`2[System.Tuple`4[Microsoft.FSharp.Core.FSharpOption`1[System.String[]],Microsoft.FSharp.Core.FSharpOption`1[System.String[]],Microsoft.FSharp.Core.FSharpOption`1[System.String[]],System.String[]],System.Tuple`2[FSharp.Compiler.EditorServices.InsertionContextEntity,FSharp.Compiler.EditorServices.InsertionContext][]] TryFindInsertionContext(Int32, FSharp.Compiler.Syntax.ParsedInput, FSharp.Compiler.EditorServices.MaybeUnresolvedIdent[], FSharp.Compiler.EditorServices.OpenStatementInsertionPoint) FSharp.Compiler.EditorServices.ParsedInput: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.EditorServices.CompletionContext] TryGetCompletionContext(FSharp.Compiler.Text.Position, FSharp.Compiler.Syntax.ParsedInput, System.String) FSharp.Compiler.EditorServices.ParsedInput: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.EditorServices.EntityKind] GetEntityKind(FSharp.Compiler.Text.Position, FSharp.Compiler.Syntax.ParsedInput) -FSharp.Compiler.EditorServices.ParsedInput: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] GetRangeOfExprLeftOfDot(FSharp.Compiler.Text.Position, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.ParsedInput]) +FSharp.Compiler.EditorServices.ParsedInput: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range] GetRangeOfExprLeftOfDot(FSharp.Compiler.Text.Position, FSharp.Compiler.Syntax.ParsedInput) FSharp.Compiler.EditorServices.ParsedInput: Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.Ident]] GetLongIdentAt(FSharp.Compiler.Syntax.ParsedInput, FSharp.Compiler.Text.Position) -FSharp.Compiler.EditorServices.ParsedInput: Microsoft.FSharp.Core.FSharpOption`1[System.String] TryFindExpressionIslandInPosition(FSharp.Compiler.Text.Position, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.ParsedInput]) -FSharp.Compiler.EditorServices.ParsedInput: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Text.Position,System.Boolean]] TryFindExpressionASTLeftOfDotLeftOfCursor(FSharp.Compiler.Text.Position, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.ParsedInput]) +FSharp.Compiler.EditorServices.ParsedInput: Microsoft.FSharp.Core.FSharpOption`1[System.String] TryFindExpressionIslandInPosition(FSharp.Compiler.Text.Position, FSharp.Compiler.Syntax.ParsedInput) +FSharp.Compiler.EditorServices.ParsedInput: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`2[FSharp.Compiler.Text.Position,System.Boolean]] TryFindExpressionASTLeftOfDotLeftOfCursor(FSharp.Compiler.Text.Position, FSharp.Compiler.Syntax.ParsedInput) FSharp.Compiler.EditorServices.ParsedInput: System.String[] GetFullNameOfSmallestModuleOrNamespaceAtPoint(FSharp.Compiler.Text.Position, FSharp.Compiler.Syntax.ParsedInput) FSharp.Compiler.EditorServices.PartialLongName FSharp.Compiler.EditorServices.PartialLongName: Boolean Equals(FSharp.Compiler.EditorServices.PartialLongName) @@ -3401,7 +3406,7 @@ FSharp.Compiler.EditorServices.UnusedOpens: Microsoft.FSharp.Control.FSharpAsync FSharp.Compiler.EditorServices.XmlDocComment FSharp.Compiler.EditorServices.XmlDocComment: Microsoft.FSharp.Core.FSharpOption`1[System.Int32] IsBlank(System.String) FSharp.Compiler.EditorServices.XmlDocParser -FSharp.Compiler.EditorServices.XmlDocParser: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.EditorServices.XmlDocable] GetXmlDocables(FSharp.Compiler.Text.ISourceText, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.ParsedInput]) +FSharp.Compiler.EditorServices.XmlDocParser: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.EditorServices.XmlDocable] GetXmlDocables(FSharp.Compiler.Text.ISourceText, FSharp.Compiler.Syntax.ParsedInput) FSharp.Compiler.EditorServices.XmlDocable FSharp.Compiler.EditorServices.XmlDocable: Boolean Equals(FSharp.Compiler.EditorServices.XmlDocable) FSharp.Compiler.EditorServices.XmlDocable: Boolean Equals(System.Object) @@ -4801,7 +4806,9 @@ FSharp.Compiler.Syntax.ParsedInput: FSharp.Compiler.Text.Range Range FSharp.Compiler.Syntax.ParsedInput: FSharp.Compiler.Text.Range get_Range() FSharp.Compiler.Syntax.ParsedInput: Int32 Tag FSharp.Compiler.Syntax.ParsedInput: Int32 get_Tag() +FSharp.Compiler.Syntax.ParsedInput: System.String FileName FSharp.Compiler.Syntax.ParsedInput: System.String ToString() +FSharp.Compiler.Syntax.ParsedInput: System.String get_FileName() FSharp.Compiler.Syntax.ParsedScriptInteraction FSharp.Compiler.Syntax.ParsedScriptInteraction+Definitions: FSharp.Compiler.Text.Range get_range() FSharp.Compiler.Syntax.ParsedScriptInteraction+Definitions: FSharp.Compiler.Text.Range range diff --git a/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs b/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs index 1ac573a84e2..bc4b3f9f0bc 100644 --- a/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs +++ b/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs @@ -6,5 +6,4 @@ module CompilerTestHelpers = let (|Warning|_|) (exn: System.Exception) = match exn with | :? FSharp.Compiler.ErrorLogger.Error as e -> let n,d = e.Data0 in Some (n,d) - | :? FSharp.Compiler.ErrorLogger.NumberedError as e -> let n,d = e.Data0 in Some (n,d) | _ -> None diff --git a/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs b/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs index 9c26cd08bff..6bb73161192 100644 --- a/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs +++ b/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs @@ -12,6 +12,7 @@ open Internal.Utilities open Internal.Utilities.Text.Lexing open FSharp.Compiler +open FSharp.Compiler.Diagnostics open FSharp.Compiler.Lexer open FSharp.Compiler.Lexhelp open FSharp.Compiler.ErrorLogger @@ -55,7 +56,7 @@ type public HashIfExpression() = let errorLogger = { new ErrorLogger("TestErrorLogger") with - member x.DiagnosticSink(e, isError) = if isError then errors.Add e else warnings.Add e + member x.DiagnosticSink(e, sev) = if sev = FSharpDiagnosticSeverity.Error then errors.Add e else warnings.Add e member x.ErrorCount = errors.Count } diff --git a/tests/FSharp.Test.Utilities/CompilerAssert.fs b/tests/FSharp.Test.Utilities/CompilerAssert.fs index 7a0cd20257d..e41689f3bba 100644 --- a/tests/FSharp.Test.Utilities/CompilerAssert.fs +++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs @@ -509,7 +509,6 @@ let main argv = 0""" |> Async.RunSynchronously Assert.IsEmpty(parseResults.Diagnostics, sprintf "Parse errors: %A" parseResults.Diagnostics) - Assert.IsTrue(parseResults.ParseTree.IsSome, "no parse tree returned") let dependencies = #if NETCOREAPP @@ -519,7 +518,7 @@ let main argv = 0""" #endif let compileErrors, statusCode = - checker.Compile([parseResults.ParseTree.Value], "test", outputFilePath, dependencies, executable = isExe, noframework = true) + checker.Compile([parseResults.ParseTree], "test", outputFilePath, dependencies, executable = isExe, noframework = true) |> Async.RunSynchronously Assert.IsEmpty(compileErrors, sprintf "Compile errors: %A" compileErrors) @@ -534,7 +533,6 @@ let main argv = 0""" |> Async.RunSynchronously Assert.IsEmpty(parseResults.Diagnostics, sprintf "Parse errors: %A" parseResults.Diagnostics) - Assert.IsTrue(parseResults.ParseTree.IsSome, "no parse tree returned") let dependencies = #if NETCOREAPP @@ -544,7 +542,7 @@ let main argv = 0""" #endif let compileErrors, statusCode, assembly = - checker.CompileToDynamicAssembly([parseResults.ParseTree.Value], assemblyName, dependencies, None, noframework = true) + checker.CompileToDynamicAssembly([parseResults.ParseTree], assemblyName, dependencies, None, noframework = true) |> Async.RunSynchronously Assert.IsEmpty(compileErrors, sprintf "Compile errors: %A" compileErrors) diff --git a/tests/service/Common.fs b/tests/service/Common.fs index 45f9f6cf109..d4ad76a2d3d 100644 --- a/tests/service/Common.fs +++ b/tests/service/Common.fs @@ -233,15 +233,14 @@ let matchBraces (name: string, code: string) = braces -let getSingleModuleLikeDecl (input: ParsedInput option) = +let getSingleModuleLikeDecl (input: ParsedInput) = match input with - | Some (ParsedInput.ImplFile (ParsedImplFileInput (modules = [ decl ]))) -> decl + | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ decl ])) -> decl | _ -> failwith "Could not get module decls" let parseSourceCodeAndGetModule (source: string) = parseSourceCode ("test", source) |> getSingleModuleLikeDecl - /// Extract range info let tups (m: range) = (m.StartLine, m.StartColumn), (m.EndLine, m.EndColumn) diff --git a/tests/service/InteractiveCheckerTests.fs b/tests/service/InteractiveCheckerTests.fs index 17921965871..ece651b1398 100644 --- a/tests/service/InteractiveCheckerTests.fs +++ b/tests/service/InteractiveCheckerTests.fs @@ -61,9 +61,7 @@ let internal identsAndRanges (input: ParsedInput) = let internal parseAndExtractRanges code = let file = "Test" let result = parseSourceCode (file, code) - match result with - | Some tree -> tree |> identsAndRanges - | None -> failwith "fail to parse..." + result |> identsAndRanges let input = """ diff --git a/tests/service/ProjectAnalysisTests.fs b/tests/service/ProjectAnalysisTests.fs index efc4f2e5142..b5a8883ae46 100644 --- a/tests/service/ProjectAnalysisTests.fs +++ b/tests/service/ProjectAnalysisTests.fs @@ -120,6 +120,7 @@ let ``Test project1 and make sure TcImports gets cleaned up`` () = Assert.True weakTcImports.IsAlive weakTcImports + // Here we are only keeping a handle to weakTcImports and nothing else let weakTcImports = test () checker.InvalidateConfiguration (Project1.options) checker.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() diff --git a/tests/service/ServiceUntypedParseTests.fs b/tests/service/ServiceUntypedParseTests.fs index 89cbcb44d06..d33ca49e828 100644 --- a/tests/service/ServiceUntypedParseTests.fs +++ b/tests/service/ServiceUntypedParseTests.fs @@ -43,14 +43,12 @@ let private (=>) (source: string) (expected: CompletionContext option) = match markerPos with | None -> failwithf "Marker '%s' was not found in the source code" Marker | Some markerPos -> - match parseSourceCode("C:\\test.fs", source) with - | None -> failwith "No parse tree" - | Some parseTree -> - let actual = ParsedInput.TryGetCompletionContext(markerPos, parseTree, lines.[Line.toZ markerPos.Line]) - try Assert.AreEqual(expected, actual) - with e -> - printfn "ParseTree: %A" parseTree - reraise() + let parseTree = parseSourceCode("C:\\test.fs", source) + let actual = ParsedInput.TryGetCompletionContext(markerPos, parseTree, lines.[Line.toZ markerPos.Line]) + try Assert.AreEqual(expected, actual) + with e -> + printfn "ParseTree: %A" parseTree + reraise() module AttributeCompletion = [] diff --git a/tests/service/StructureTests.fs b/tests/service/StructureTests.fs index b4ec0e77ac5..280c2a206e8 100644 --- a/tests/service/StructureTests.fs +++ b/tests/service/StructureTests.fs @@ -42,18 +42,15 @@ let (=>) (source: string) (expectedRanges: (Range * Range) list) = let ast = parseSourceCode(fileName, source) try - match ast with - | Some tree -> - let actual = - Structure.getOutliningRanges lines tree - |> Seq.filter (fun sr -> sr.Range.StartLine <> sr.Range.EndLine) - |> Seq.map (fun sr -> getRange sr.Range, getRange sr.CollapseRange) - |> Seq.sort - |> List.ofSeq - let expected = List.sort expectedRanges - if actual <> expected then - failwithf "Expected %s, but was %s" (formatList expected) (formatList actual) - | None -> failwithf "Expected there to be a parse tree for source:\n%s" source + let actual = + Structure.getOutliningRanges lines ast + |> Seq.filter (fun sr -> sr.Range.StartLine <> sr.Range.EndLine) + |> Seq.map (fun sr -> getRange sr.Range, getRange sr.CollapseRange) + |> Seq.sort + |> List.ofSeq + let expected = List.sort expectedRanges + if actual <> expected then + failwithf "Expected %s, but was %s" (formatList expected) (formatList actual) with _ -> printfn "AST:\n%+A" ast reraise() diff --git a/tests/service/Symbols.fs b/tests/service/Symbols.fs index 65d48ea3b46..c36ed9fc13b 100644 --- a/tests/service/Symbols.fs +++ b/tests/service/Symbols.fs @@ -270,34 +270,32 @@ module SyntaxExpressions = |> getParseResults match ast with - | Some(ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [ SynBinding(expr = SynExpr.Sequential(expr1 = SynExpr.Do(_, doRange) ; expr2 = SynExpr.DoBang(_, doBangRange))) ]) ]) - ]))) -> + ])) -> assertRange (2, 4) (3, 14) doRange assertRange (4, 4) (5, 18) doBangRange | _ -> failwith "Could not find SynExpr.Do" module Strings = - let getBindingExpressionValue (parseResults: ParsedInput option) = - parseResults - |> Option.bind (fun tree -> - match tree with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = modules)) -> - modules |> List.tryPick (fun (SynModuleOrNamespace (decls = decls)) -> - decls |> List.tryPick (fun decl -> - match decl with - | SynModuleDecl.Let (bindings = bindings) -> - bindings |> List.tryPick (fun binding -> - match binding with - | SynBinding.SynBinding (_,_,_,_,_,_,_,SynPat.Named _,_,e,_,_) -> Some e - | _ -> None) - | _ -> None)) - | _ -> None) + let getBindingExpressionValue (parseResults: ParsedInput) = + match parseResults with + | ParsedInput.ImplFile (ParsedImplFileInput (modules = modules)) -> + modules |> List.tryPick (fun (SynModuleOrNamespace (decls = decls)) -> + decls |> List.tryPick (fun decl -> + match decl with + | SynModuleDecl.Let (bindings = bindings) -> + bindings |> List.tryPick (fun binding -> + match binding with + | SynBinding.SynBinding (_,_,_,_,_,_,_,SynPat.Named _,_,e,_,_) -> Some e + | _ -> None) + | _ -> None)) + | _ -> None let getBindingConstValue parseResults = match getBindingExpressionValue parseResults with @@ -400,7 +398,7 @@ type Teq<'a, 'b> """ match parseResults with - | Some (ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(kind = SynModuleOrNamespaceKind.DeclaredNamespace; range = r) ]))) -> + | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(kind = SynModuleOrNamespaceKind.DeclaredNamespace; range = r) ])) -> assertRange (1, 0) (4, 8) r | _ -> failwith "Could not get valid AST" @@ -419,9 +417,9 @@ let x = 42 """ match parseResults with - | Some (ParsedInput.ImplFile (ParsedImplFileInput (modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(kind = SynModuleOrNamespaceKind.DeclaredNamespace; range = r1) - SynModuleOrNamespace.SynModuleOrNamespace(kind = SynModuleOrNamespaceKind.DeclaredNamespace; range = r2) ]))) -> + SynModuleOrNamespace.SynModuleOrNamespace(kind = SynModuleOrNamespaceKind.DeclaredNamespace; range = r2) ])) -> assertRange (1, 0) (4, 20) r1 assertRange (6, 0) (8, 10) r2 | _ -> failwith "Could not get valid AST" \ No newline at end of file diff --git a/tests/service/TreeVisitorTests.fs b/tests/service/TreeVisitorTests.fs index c7fbabc003a..206b7daaf8e 100644 --- a/tests/service/TreeVisitorTests.fs +++ b/tests/service/TreeVisitorTests.fs @@ -13,10 +13,7 @@ let ``Visit type test`` () = member x.VisitType(_, _, _) = Some () } let source = "123 :? int" - let parseTree = - match parseSourceCode("C:\\test.fs", source) with - | None -> failwith "No parse tree" - | Some parseTree -> parseTree + let parseTree = parseSourceCode("C:\\test.fs", source) SyntaxTraversal.Traverse(mkPos 1 11, parseTree, visitor) |> Option.defaultWith (fun _ -> failwith "Did not visit type") diff --git a/vsintegration/src/FSharp.Editor/Commands/XmlDocCommandService.fs b/vsintegration/src/FSharp.Editor/Commands/XmlDocCommandService.fs index cca16374d7d..fcf9eeaec39 100644 --- a/vsintegration/src/FSharp.Editor/Commands/XmlDocCommandService.fs +++ b/vsintegration/src/FSharp.Editor/Commands/XmlDocCommandService.fs @@ -69,7 +69,7 @@ type internal XmlDocCommandFilter let! parsingOptions, _options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document, CancellationToken.None, userOpName) let! sourceText = document.GetTextAsync(CancellationToken.None) let! parsedInput = checker.ParseDocument(document, parsingOptions, sourceText, userOpName) - let xmlDocables = XmlDocParser.GetXmlDocables (sourceText.ToFSharpSourceText(), Some parsedInput) + let xmlDocables = XmlDocParser.GetXmlDocables (sourceText.ToFSharpSourceText(), parsedInput) let xmlDocablesBelowThisLine = // +1 because looking below current line for e.g. a 'member' xmlDocables |> List.filter (fun (XmlDocable(line,_indent,_paramNames)) -> line = curLineNum+1) diff --git a/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs b/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs index 6e3cb4c34b4..7eca0659392 100644 --- a/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs +++ b/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs @@ -142,10 +142,15 @@ module internal RoslynHelpers = // (i.e the same error does not appear twice, where the only difference is the line endings.) let normalizedMessage = error.Message |> FSharpDiagnostic.NormalizeErrorString |> FSharpDiagnostic.NewlineifyErrorString - let id = "FS" + error.ErrorNumber.ToString("0000") + let id = error.ErrorNumberText let emptyString = LocalizableString.op_Implicit("") let description = LocalizableString.op_Implicit(normalizedMessage) - let severity = if error.Severity = FSharpDiagnosticSeverity.Error then DiagnosticSeverity.Error else DiagnosticSeverity.Warning + let severity = + match error.Severity with + | FSharpDiagnosticSeverity.Error -> DiagnosticSeverity.Error + | FSharpDiagnosticSeverity.Warning -> DiagnosticSeverity.Warning + | FSharpDiagnosticSeverity.Info -> DiagnosticSeverity.Info + | FSharpDiagnosticSeverity.Hidden -> DiagnosticSeverity.Hidden let customTags = match error.ErrorNumber with | 1182 -> FSharpDiagnosticCustomTags.Unnecessary diff --git a/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs b/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs index 382c97db4f2..4ae416cc9c2 100644 --- a/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs +++ b/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs @@ -195,10 +195,7 @@ type internal FSharpCompletionProvider if results.Count > 0 && not declarations.IsForType && not declarations.IsError && List.isEmpty partialName.QualifyingIdents then - let completionContext = - parseResults.ParseTree - |> Option.bind (fun parseTree -> - ParsedInput.TryGetCompletionContext(Position.fromZ caretLinePos.Line caretLinePos.Character, parseTree, line)) + let completionContext = ParsedInput.TryGetCompletionContext(Position.fromZ caretLinePos.Line caretLinePos.Character, parseResults.ParseTree, line) match completionContext with | None -> results.AddRange(keywordCompletionItems) diff --git a/vsintegration/src/FSharp.Editor/LanguageService/FSharpCheckerExtensions.fs b/vsintegration/src/FSharp.Editor/LanguageService/FSharpCheckerExtensions.fs index b62c9a8e536..e70577b9363 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/FSharpCheckerExtensions.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/FSharpCheckerExtensions.fs @@ -12,7 +12,7 @@ type FSharpChecker with member checker.ParseDocument(document: Document, parsingOptions: FSharpParsingOptions, sourceText: SourceText, userOpName: string) = asyncMaybe { let! fileParseResults = checker.ParseFile(document.FilePath, sourceText.ToFSharpSourceText(), parsingOptions, userOpName=userOpName) |> liftAsync - return! fileParseResults.ParseTree + return fileParseResults.ParseTree } member checker.ParseAndCheckDocument(filePath: string, textVersionHash: int, sourceText: SourceText, options: FSharpProjectOptions, languageServicePerformanceOptions: LanguageServicePerformanceOptions, userOpName: string) = @@ -40,9 +40,7 @@ type FSharpChecker with let bindParsedInput(results: (FSharpParseFileResults * FSharpCheckFileResults) option) = match results with | Some(parseResults, checkResults) -> - match parseResults.ParseTree with - | Some parsedInput -> Some (parseResults, parsedInput, checkResults) - | None -> None + Some (parseResults, parseResults.ParseTree, checkResults) | None -> None if languageServicePerformanceOptions.AllowStaleCompletionResults then diff --git a/vsintegration/src/FSharp.Editor/Navigation/NavigateToSearchService.fs b/vsintegration/src/FSharp.Editor/Navigation/NavigateToSearchService.fs index 346062c925c..0260ebd0c59 100644 --- a/vsintegration/src/FSharp.Editor/Navigation/NavigateToSearchService.fs +++ b/vsintegration/src/FSharp.Editor/Navigation/NavigateToSearchService.fs @@ -184,18 +184,17 @@ type internal FSharpNavigateToSearchService NavigateTo.GetNavigableItems parsedInput |> Array.filter (fun i -> kinds.Contains(navigateToItemKindToRoslynKind i.Kind)) - return - match parseResults.ParseTree |> Option.map navItems with - | Some items -> - [| for item in items do - match RoslynHelpers.TryFSharpRangeToTextSpan(sourceText, item.Range) with - | None -> () - | Some sourceSpan -> - let glyph = navigateToItemKindToGlyph item.Kind - let kind = navigateToItemKindToRoslynKind item.Kind - let additionalInfo = containerToString item.Container document.Project - yield NavigableItem(document, sourceSpan, glyph, item.Name, kind, additionalInfo) |] - | None -> [||] + let items = parseResults.ParseTree |> navItems + let navigableItems = + [| for item in items do + match RoslynHelpers.TryFSharpRangeToTextSpan(sourceText, item.Range) with + | None -> () + | Some sourceSpan -> + let glyph = navigateToItemKindToGlyph item.Kind + let kind = navigateToItemKindToRoslynKind item.Kind + let additionalInfo = containerToString item.Container document.Project + yield NavigableItem(document, sourceSpan, glyph, item.Name, kind, additionalInfo) |] + return navigableItems } let getCachedIndexedNavigableItems(document: Document, parsingOptions: FSharpParsingOptions, kinds: IImmutableSet) = From 46bc472d61e347640e2b21acb66d721e88643e21 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 25 Feb 2021 23:26:10 +0000 Subject: [PATCH 02/15] eventually/cancellable cleanup --- src/fsharp/ParseAndCheckInputs.fs | 8 +- src/fsharp/absil/illib.fs | 134 ++++--- src/fsharp/absil/illib.fsi | 46 ++- src/fsharp/fsi/fsi.fs | 9 +- src/fsharp/fsi/fsi.fsi | 5 +- src/fsharp/service/FSharpCheckerResults.fs | 110 ++---- src/fsharp/service/FSharpCheckerResults.fsi | 8 +- src/fsharp/service/IncrementalBuild.fs | 402 +++++++++----------- src/fsharp/service/IncrementalBuild.fsi | 14 +- src/fsharp/service/Reactor.fs | 60 ++- src/fsharp/service/Reactor.fsi | 3 +- src/fsharp/service/service.fs | 74 ++-- 12 files changed, 419 insertions(+), 454 deletions(-) diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index a0667246250..a0a26f346aa 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -5,6 +5,7 @@ module internal FSharp.Compiler.ParseAndCheckInputs open System open System.IO +open System.Threading open Internal.Utilities open Internal.Utilities.Collections @@ -700,9 +701,6 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig: TcConfig, tcImports: eventually { try - let! ctok = Eventually.token - RequireCompilationThread ctok // Everything here requires the compilation thread since it works on the TAST - CheckSimulateException tcConfig let m = inp.Range @@ -826,8 +824,10 @@ let TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, pre // 'use' ensures that the warning handler is restored at the end use unwindEL = PushErrorLoggerPhaseUntilUnwind(fun oldLogger -> GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput inp, oldLogger) ) use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck + + RequireCompilationThread ctok TypeCheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, inp, false) - |> Eventually.force ctok + |> Eventually.force /// Finish checking multiple files (or one interactive entry into F# Interactive) let TypeCheckMultipleInputsFinish(results, tcState: TcState) = diff --git a/src/fsharp/absil/illib.fs b/src/fsharp/absil/illib.fs index 07fa43490a2..c2d536c3b7a 100644 --- a/src/fsharp/absil/illib.fs +++ b/src/fsharp/absil/illib.fs @@ -637,6 +637,7 @@ type ExecutionToken = interface end /// /// Like other execution tokens this should be passed via argument passing and not captured/stored beyond /// the lifetime of stack-based calls. This is not checked, it is a discipline within the compiler code. +[] type CompilationThreadToken() = interface ExecutionToken /// A base type for various types of tokens that must be passed when a lock is taken. @@ -644,6 +645,7 @@ type CompilationThreadToken() = interface ExecutionToken type LockToken = inherit ExecutionToken /// Represents a token that indicates execution on any of several potential user threads calling the F# compiler services. +[] type AnyCallerThreadToken() = interface ExecutionToken [] @@ -719,7 +721,19 @@ module Cancellable = if ct.IsCancellationRequested then ValueOrCancelled.Cancelled (OperationCanceledException ct) else - oper ct + try oper ct + with + | :? OperationCanceledException as e -> + ValueOrCancelled.Cancelled e + | _ -> reraise() + + let runThrowing (ct: CancellationToken) (Cancellable oper) = + if ct.IsCancellationRequested then + raise (OperationCanceledException ct) + else + match oper ct with + | ValueOrCancelled.Cancelled ce -> raise ce + | ValueOrCancelled.Value v -> v /// Bind the result of a cancellable computation let bind f comp1 = @@ -773,6 +787,16 @@ module Cancellable = | ValueOrCancelled.Cancelled _ -> failwith "unexpected cancellation" | ValueOrCancelled.Value r -> r + let toAsync c = + async { + let! ct = Async.CancellationToken + let res = run ct c + return! Async.FromContinuations (fun (cont, _econt, ccont) -> + match res with + | ValueOrCancelled.Value v -> cont v + | ValueOrCancelled.Cancelled ce -> ccont ce) + } + /// Bind the cancellation token associated with the computation let token () = Cancellable (fun ct -> ValueOrCancelled.Value ct) @@ -800,22 +824,6 @@ module Cancellable = catch e |> bind (fun res -> match res with Choice1Of2 r -> ret r | Choice2Of2 err -> handler err) - // Run the cancellable computation within an Async computation. This isn't actually used in the codebase, but left - // here in case we need it in the future - // - // let toAsync e = - // async { - // let! ct = Async.CancellationToken - // return! - // Async.FromContinuations(fun (cont, econt, ccont) -> - // // Run the computation synchronously using the given cancellation token - // let res = try Choice1Of2 (run ct e) with err -> Choice2Of2 err - // match res with - // | Choice1Of2 (ValueOrCancelled.Value v) -> cont v - // | Choice1Of2 (ValueOrCancelled.Cancelled err) -> ccont err - // | Choice2Of2 err -> econt err) - // } - type CancellableBuilder() = member x.Bind(e, k) = Cancellable.bind k e @@ -856,54 +864,59 @@ module CancellableAutoOpens = /// - Cancellation results in a suspended computation rather than complete abandonment type Eventually<'T> = | Done of 'T - | NotYetDone of (CompilationThreadToken -> Eventually<'T>) + | NotYetDone of (unit -> Eventually<'T>) module Eventually = - let rec box e = + let rec map f e = match e with - | Done x -> Done (Operators.box x) - | NotYetDone work -> NotYetDone (fun ctok -> box (work ctok)) + | Done x -> Done (f x) + | NotYetDone work -> NotYetDone (fun ct -> map f (work ct)) - let rec forceWhile ctok check e = - match e with - | Done x -> Some x - | NotYetDone work -> - if not(check()) - then None - else forceWhile ctok check (work ctok) + let box e = map Operators.box e + + let toCancellable e = + Cancellable (fun ct -> + let rec loop e = + match e with + | Done x -> ValueOrCancelled.Value x + | NotYetDone work -> + if ct.IsCancellationRequested then + ValueOrCancelled.Cancelled (OperationCanceledException ct) + else + loop (work()) + loop e) + + let forceCancellable ct e = Cancellable.run ct (toCancellable e) + + let forceCancellableThrowing ct e = Cancellable.runThrowing ct (toCancellable e) + + let rec force e = + match e with + | Done x -> x + | NotYetDone work -> force (work()) + + let forceForTimeSlice (sw: Stopwatch) timeShareInMilliseconds (ct: CancellationToken) e = + sw.Reset() + sw.Start() + let rec loop ev2 = + match ev2 with + | Done _ -> ev2 + | NotYetDone work -> + if ct.IsCancellationRequested || sw.ElapsedMilliseconds > timeShareInMilliseconds then + sw.Stop() + ev2 + else + loop (work()) + loop e - let force ctok e = Option.get (forceWhile ctok (fun () -> true) e) - - /// Keep running the computation bit by bit until a time limit is reached. - /// The runner gets called each time the computation is restarted - /// - /// If cancellation happens, the operation is left half-complete, ready to resume. - let repeatedlyProgressUntilDoneOrTimeShareOverOrCanceled timeShareInMilliseconds (ct: CancellationToken) runner e = - let sw = new Stopwatch() - let rec runTimeShare ctok e = - runner ctok (fun ctok -> - sw.Reset() - sw.Start() - let rec loop ctok ev2 = - match ev2 with - | Done _ -> ev2 - | NotYetDone work -> - if ct.IsCancellationRequested || sw.ElapsedMilliseconds > timeShareInMilliseconds then - sw.Stop() - NotYetDone(fun ctok -> runTimeShare ctok ev2) - else - loop ctok (work ctok) - loop ctok e) - NotYetDone (fun ctok -> runTimeShare ctok e) - /// Keep running the asynchronous computation bit by bit. The runner gets called each time the computation is restarted. /// Can be cancelled as an Async in the normal way. - let forceAsync (runner: (CompilationThreadToken -> Eventually<'T>) -> Async>) (e: Eventually<'T>) : Async<'T option> = + let forceAsync (runner: (unit -> Eventually<'T>) -> Async>) (e: Eventually<'T>) : Async<'T> = let rec loop (e: Eventually<'T>) = async { match e with - | Done x -> return Some x + | Done x -> return x | NotYetDone work -> let! r = runner work return! loop r @@ -913,7 +926,7 @@ module Eventually = let rec bind k e = match e with | Done x -> k x - | NotYetDone work -> NotYetDone (fun ctok -> bind k (work ctok)) + | NotYetDone work -> NotYetDone (fun ct -> bind k (work ct)) let fold f acc seq = (Done acc, seq) ||> Seq.fold (fun acc x -> acc |> bind (fun acc -> f acc x)) @@ -922,8 +935,8 @@ module Eventually = match e with | Done x -> Done(Result x) | NotYetDone work -> - NotYetDone (fun ctok -> - let res = try Result(work ctok) with | e -> Exception e + NotYetDone (fun ct -> + let res = try Result(work ct) with | e -> Exception e match res with | Result cont -> catch cont | Exception e -> Done(Exception e)) @@ -942,12 +955,11 @@ module Eventually = catch e |> bind (function Result v -> Done v | Exception e -> handler e) - // All eventually computations carry a CompilationThreadToken - let token = - NotYetDone (fun ctok -> Done ctok) - + type EventuallyBuilder() = + member x.BindReturn(e, k) = Eventually.map k e + member x.Bind(e, k) = Eventually.bind k e member x.Return v = Eventually.Done v diff --git a/src/fsharp/absil/illib.fsi b/src/fsharp/absil/illib.fsi index c63bc2a1b10..cbc034cf653 100644 --- a/src/fsharp/absil/illib.fsi +++ b/src/fsharp/absil/illib.fsi @@ -5,6 +5,7 @@ namespace Internal.Utilities.Library open System open System.Threading open System.Collections.Generic +open System.Diagnostics open System.Runtime.CompilerServices [] @@ -275,12 +276,14 @@ type internal ExecutionToken = interface end /// /// Like other execution tokens this should be passed via argument passing and not captured/stored beyond /// the lifetime of stack-based calls. This is not checked, it is a discipline within the compiler code. +[] type internal CompilationThreadToken = interface ExecutionToken new: unit -> CompilationThreadToken /// Represents a token that indicates execution on any of several potential user threads calling the F# compiler services. +[] type internal AnyCallerThreadToken = interface ExecutionToken @@ -354,6 +357,10 @@ module internal Cancellable = /// Run a cancellable computation using the given cancellation token val run : ct:CancellationToken -> Cancellable<'a> -> ValueOrCancelled<'a> + /// Run a cancellable computation using the given cancellation token. Raise OperationCanceledException + /// if cancellation occurs + val runThrowing : ct:CancellationToken -> Cancellable<'a> -> 'a + /// Bind the result of a cancellable computation val bind : f:('a -> Cancellable<'b>) -> comp1:Cancellable<'a> -> Cancellable<'b> @@ -388,6 +395,8 @@ module internal Cancellable = /// Implement try/with for a cancellable computation val tryWith : e:Cancellable<'a> -> handler:(exn -> Cancellable<'a>) -> Cancellable<'a> + val toAsync: Cancellable<'a> -> Async<'a> + type internal CancellableBuilder = new: unit -> CancellableBuilder @@ -425,35 +434,31 @@ module internal CancellableAutoOpens = /// captured by the NotYetDone closure. Computations do not need to be restartable. /// /// - The key thing is that you can take an Eventually value and run it with -/// Eventually.repeatedlyProgressUntilDoneOrTimeShareOverOrCanceled -/// -/// - Cancellation results in a suspended computation rather than complete abandonment +/// Eventually.forceForTimeSlice type internal Eventually<'T> = | Done of 'T - | NotYetDone of (CompilationThreadToken -> Eventually<'T>) + | NotYetDone of (unit -> Eventually<'T>) module internal Eventually = val box: e:Eventually<'a> -> Eventually - val forceWhile : ctok:CompilationThreadToken -> check:(unit -> bool) -> e:Eventually<'a> -> 'a option + val toCancellable: e:Eventually<'a> -> Cancellable<'a> - val force: ctok:CompilationThreadToken -> e:Eventually<'a> -> 'a + val force: e:Eventually<'a> -> 'a - /// Keep running the computation bit by bit until a time limit is reached. - /// The runner gets called each time the computation is restarted - /// - /// If cancellation happens, the operation is left half-complete, ready to resume. - val repeatedlyProgressUntilDoneOrTimeShareOverOrCanceled : - timeShareInMilliseconds:int64 -> - ct:CancellationToken -> - runner:(CompilationThreadToken -> (#CompilationThreadToken -> Eventually<'b>) -> Eventually<'b>) -> - e:Eventually<'b> - -> Eventually<'b> + val forceCancellable: ct: CancellationToken -> e:Eventually<'a> -> ValueOrCancelled<'a> + + val forceCancellableThrowing: ct: CancellationToken -> e:Eventually<'a> -> 'a + + /// Run for at most the given time slice, returning the residue computation, which may be complete. + /// If cancellation is requested then just return the computation at the point where cancellation + /// was detected. + val forceForTimeSlice: sw:Stopwatch -> timeShareInMilliseconds: int64 -> ct: CancellationToken -> e: Eventually<'b> -> Eventually<'b> /// Keep running the asynchronous computation bit by bit. The runner gets called each time the computation is restarted. - /// Can be cancelled as an Async in the normal way. - val forceAsync : runner:((CompilationThreadToken -> Eventually<'T>) -> Async>) -> e:Eventually<'T> -> Async<'T option> + /// Can be cancelled as an Async in the normal way. If cancelled the partially computed computation is lost + val forceAsync: runner:((unit -> Eventually<'T>) -> Async>) -> e:Eventually<'T> -> Async<'T> val bind: k:('a -> Eventually<'b>) -> e:Eventually<'a> -> Eventually<'b> @@ -467,12 +472,11 @@ module internal Eventually = val tryWith : e:Eventually<'a> -> handler:(System.Exception -> Eventually<'a>) -> Eventually<'a> - // All eventually computations carry a CompilationThreadToken - val token: Eventually - [] type internal EventuallyBuilder = + member BindReturn: e:Eventually<'g> * k:('g -> 'h) -> Eventually<'h> + member Bind: e:Eventually<'g> * k:('g -> Eventually<'h>) -> Eventually<'h> member Combine: e1:Eventually * e2:Eventually<'d> -> Eventually<'d> diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 303f20e8439..cd848d1bba7 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -2663,10 +2663,10 @@ type internal FsiInteractionProcessor let names = names |> List.filter (fun name -> name.StartsWithOrdinal(stem)) names - member _.ParseAndCheckInteraction (ctok, legacyReferenceResolver, checker, istate, text:string) = + member _.ParseAndCheckInteraction (ctok, legacyReferenceResolver, istate, text:string) = let tcConfig = TcConfig.Create(tcConfigB,validate=false) - let fsiInteractiveChecker = FsiInteractiveChecker(legacyReferenceResolver, checker, tcConfig, istate.tcGlobals, istate.tcImports, istate.tcState) + let fsiInteractiveChecker = FsiInteractiveChecker(legacyReferenceResolver, tcConfig, istate.tcGlobals, istate.tcImports, istate.tcState) fsiInteractiveChecker.ParseAndCheckInteraction(ctok, SourceText.ofString text) @@ -2748,7 +2748,6 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i // To support fsi usage, the console coloring is switched off by default on Mono. do if runningOnMono then enableConsoleColoring <- false - //---------------------------------------------------------------------------- // tcConfig - build the initial config //---------------------------------------------------------------------------- @@ -2941,7 +2940,8 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i member x.ParseAndCheckInteraction(code) = let ctok = AssumeCompilationThreadWithoutEvidence () - fsiInteractionProcessor.ParseAndCheckInteraction (ctok, legacyReferenceResolver, checker.ReactorOps, fsiInteractionProcessor.CurrentState, code) + fsiInteractionProcessor.ParseAndCheckInteraction (ctok, legacyReferenceResolver, fsiInteractionProcessor.CurrentState, code) + |> Cancellable.runWithoutCancellation member x.InteractiveChecker = checker @@ -2950,6 +2950,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i member x.DynamicAssembly = fsiDynamicCompiler.DynamicAssembly + /// A host calls this to determine if the --gui parameter is active member x.IsGui = fsiOptions.Gui diff --git a/src/fsharp/fsi/fsi.fsi b/src/fsharp/fsi/fsi.fsi index d917815ca91..ba3bfc149cd 100644 --- a/src/fsharp/fsi/fsi.fsi +++ b/src/fsharp/fsi/fsi.fsi @@ -229,10 +229,7 @@ type FsiEvaluationSession = /// check brace matching and other information. /// /// Operations may be run concurrently with other requests to the InteractiveChecker. - /// - /// Due to a current limitation, it is not fully thread-safe to run this operation concurrently with evaluation triggered - /// by input from 'stdin'. - member ParseAndCheckInteraction: code: string -> Async + member ParseAndCheckInteraction: code: string -> FSharpParseFileResults * FSharpCheckFileResults * FSharpCheckProjectResults /// The single, global interactive checker to use in conjunction with other operations /// on the FsiEvaluationSession. diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index 081e08874bb..3690154175d 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -105,14 +105,6 @@ module internal FSharpCheckerResultsSettings = let maxTypeCheckErrorsOutOfProjectContext = GetEnvInteger "FCS_MaxErrorsOutOfProjectContext" 3 - /// Maximum time share for a piece of background work before it should (cooperatively) yield - /// to enable other requests to be serviced. Yielding means returning a continuation function - /// (via an Eventually<_> value of case NotYetDone) that can be called as the next piece of work. - let maxTimeShareMilliseconds = - match System.Environment.GetEnvironmentVariable("FCS_MaxTimeShare") with - | null | "" -> 100L - | s -> int64 s - // Look for DLLs in the location of the service DLL first. let defaultFSharpBinariesDir = FSharpEnvironment.BinFolderOfDefaultFSharpCompiler(Some(Path.GetDirectoryName(typeof.Assembly.Location))).Value @@ -1735,10 +1727,9 @@ module internal ParseAndCheckFile = loadClosure: LoadClosure option, // These are the errors and warnings seen by the background compiler for the entire antecedent backgroundDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity)[], - reactorOps: IReactorOperations, - userOpName: string, - suggestNamesForErrors: bool) = async { + suggestNamesForErrors: bool) = + cancellable { use _logBlock = Logger.LogBlock LogCompilerFunctionId.Service_CheckOneFile let parsedMainInput = parseResults.ParseTree @@ -1756,7 +1747,7 @@ module internal ParseAndCheckFile = errHandler.ErrorSeverityOptions <- tcConfig.errorSeverityOptions // Play background errors and warnings for this file. - for err, severity in backgroundDiagnostics do + do for err, severity in backgroundDiagnostics do diagnosticSink (err, severity) // If additional references were brought in by the preprocessor then we need to process them @@ -1770,10 +1761,8 @@ module internal ParseAndCheckFile = // Typecheck the real input. let sink = TcResultsSinkImpl(tcGlobals, sourceText = sourceText) - let! ct = Async.CancellationToken - let! resOpt = - async { + cancellable { try let checkForErrors() = (parseResults.ParseHadErrors || errHandler.ErrorCount > 0) @@ -1782,33 +1771,23 @@ module internal ParseAndCheckFile = // Typecheck is potentially a long running operation. We chop it up here with an Eventually continuation and, at each slice, give a chance // for the client to claim the result as obsolete and have the typecheck abort. + use _unwind = new CompilationGlobalsScope (errHandler.ErrorLogger, BuildPhase.TypeCheck) let! result = TypeCheckOneInputAndFinishEventually(checkForErrors, tcConfig, tcImports, tcGlobals, None, TcResultsSink.WithSink sink, tcState, parsedMainInput) - |> Eventually.repeatedlyProgressUntilDoneOrTimeShareOverOrCanceled maxTimeShareMilliseconds ct (fun ctok f -> f ctok) - |> Eventually.forceAsync - (fun work -> - reactorOps.EnqueueAndAwaitOpAsync(userOpName, "CheckOneFile.Fragment", mainInputFileName, - fun ctok -> - // This work is not cancellable - let res = - // Reinstall the compilation globals each time we start or restart - use unwind = new CompilationGlobalsScope (errHandler.ErrorLogger, BuildPhase.TypeCheck) - work ctok - cancellable.Return(res) - )) + |> Eventually.toCancellable return result with e -> errorR e let mty = Construct.NewEmptyModuleOrNamespaceType ModuleOrNamespaceKind.Namespace - return Some((tcState.TcEnvFromSignatures, EmptyTopAttrs, [], [ mty ]), tcState) - } + return ((tcState.TcEnvFromSignatures, EmptyTopAttrs, [], [ mty ]), tcState) + } let errors = errHandler.CollectedDiagnostics let res = match resOpt with - | Some ((tcEnvAtEnd, _, implFiles, ccuSigsForFiles), tcState) -> + | ((tcEnvAtEnd, _, implFiles, ccuSigsForFiles), tcState) -> TypeCheckInfo(tcConfig, tcGlobals, List.head ccuSigsForFiles, tcState.Ccu, @@ -1823,12 +1802,8 @@ module internal ParseAndCheckFile = loadClosure, List.tryHead implFiles, sink.GetOpenDeclarations()) - |> Result.Ok - | None -> - Result.Error() return errors, res - } - + } [] type FSharpProjectContext(thisCcu: CcuThunk, assemblies: FSharpAssembly list, ad: AccessorDomain, projectOptions: FSharpProjectOptions) = @@ -2071,8 +2046,6 @@ type FSharpCheckFileResults moduleNamesDict: ModuleNamesDict, loadClosure: LoadClosure option, backgroundDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity)[], - reactorOps: IReactorOperations, - userOpName: string, isIncompleteTypeCheckEnvironment: bool, projectOptions: FSharpProjectOptions, builder: IncrementalBuilder, @@ -2081,27 +2054,17 @@ type FSharpCheckFileResults parseErrors: FSharpDiagnostic[], keepAssemblyContents: bool, suggestNamesForErrors: bool) = - async { + cancellable { let! tcErrors, tcFileInfo = ParseAndCheckFile.CheckOneFile (parseResults, sourceText, mainInputFileName, projectOptions, projectFileName, tcConfig, tcGlobals, tcImports, - tcState, moduleNamesDict, loadClosure, backgroundDiagnostics, reactorOps, - userOpName, suggestNamesForErrors) - match tcFileInfo with - | Result.Error () -> - return FSharpCheckFileAnswer.Aborted - | Result.Ok tcFileInfo -> - let errors = FSharpCheckFileResults.JoinErrors(isIncompleteTypeCheckEnvironment, creationErrors, parseErrors, tcErrors) - let results = FSharpCheckFileResults (mainInputFileName, errors, Some tcFileInfo, dependencyFiles, Some builder, keepAssemblyContents) - return FSharpCheckFileAnswer.Succeeded(results) + tcState, moduleNamesDict, loadClosure, backgroundDiagnostics, suggestNamesForErrors) + let errors = FSharpCheckFileResults.JoinErrors(isIncompleteTypeCheckEnvironment, creationErrors, parseErrors, tcErrors) + let results = FSharpCheckFileResults (mainInputFileName, errors, Some tcFileInfo, dependencyFiles, Some builder, keepAssemblyContents) + return results } -and [] FSharpCheckFileAnswer = - | Aborted - | Succeeded of FSharpCheckFileResults - - [] // 'details' is an option because the creation of the tcGlobals etc. for the project may have failed. type FSharpCheckProjectResults @@ -2216,7 +2179,6 @@ type FSharpCheckProjectResults override _.ToString() = "FSharpCheckProjectResults(" + projectFileName + ")" type FsiInteractiveChecker(legacyReferenceResolver, - reactorOps: IReactorOperations, tcConfig: TcConfig, tcGlobals: TcGlobals, tcImports: TcImports, @@ -2225,7 +2187,7 @@ type FsiInteractiveChecker(legacyReferenceResolver, let keepAssemblyContents = false member _.ParseAndCheckInteraction (ctok, sourceText: ISourceText, ?userOpName: string) = - async { + cancellable { let userOpName = defaultArg userOpName "Unknown" let filename = Path.Combine(tcConfig.implicitIncludeDir, "stdin.fsx") let suggestNamesForErrors = true // Will always be true, this is just for readability @@ -2273,24 +2235,26 @@ type FsiInteractiveChecker(legacyReferenceResolver, (parseResults, sourceText, filename, projectOptions, projectOptions.ProjectFileName, tcConfig, tcGlobals, tcImports, tcState, Map.empty, Some loadClosure, backgroundDiagnostics, - reactorOps, userOpName, suggestNamesForErrors) - - return - match tcFileInfo with - | Result.Ok tcFileInfo -> - let errors = Array.append parseErrors tcErrors - let typeCheckResults = FSharpCheckFileResults (filename, errors, Some tcFileInfo, dependencyFiles, None, false) - let projectResults = - FSharpCheckProjectResults (filename, Some tcConfig, - keepAssemblyContents, errors, - Some(tcGlobals, tcImports, tcFileInfo.ThisCcu, tcFileInfo.CcuSigForFile, - [tcFileInfo.ScopeSymbolUses], None, None, mkSimpleAssemblyRef "stdin", - tcState.TcEnvFromImpls.AccessRights, None, dependencyFiles, - projectOptions)) - - parseResults, typeCheckResults, projectResults - - | Result.Error () -> - failwith "unexpected aborted" + suggestNamesForErrors) + + let errors = Array.append parseErrors tcErrors + let typeCheckResults = FSharpCheckFileResults (filename, errors, Some tcFileInfo, dependencyFiles, None, false) + let projectResults = + FSharpCheckProjectResults (filename, Some tcConfig, + keepAssemblyContents, errors, + Some(tcGlobals, tcImports, tcFileInfo.ThisCcu, tcFileInfo.CcuSigForFile, + [tcFileInfo.ScopeSymbolUses], None, None, mkSimpleAssemblyRef "stdin", + tcState.TcEnvFromImpls.AccessRights, None, dependencyFiles, + projectOptions)) + + return parseResults, typeCheckResults, projectResults } +/// The result of calling TypeCheckResult including the possibility of abort and background compiler not caught up. +type [] public FSharpCheckFileAnswer = + /// Aborted because cancellation caused an abandonment of the operation + | Aborted + + /// Success + | Succeeded of FSharpCheckFileResults + diff --git a/src/fsharp/service/FSharpCheckerResults.fsi b/src/fsharp/service/FSharpCheckerResults.fsi index 0f519ca7572..93ab0cfcf05 100644 --- a/src/fsharp/service/FSharpCheckerResults.fsi +++ b/src/fsharp/service/FSharpCheckerResults.fsi @@ -348,8 +348,6 @@ type public FSharpCheckFileResults = moduleNamesDict: ModuleNamesDict * loadClosure: LoadClosure option * backgroundDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity)[] * - reactorOps: IReactorOperations * - userOpName: string * isIncompleteTypeCheckEnvironment: bool * projectOptions: FSharpProjectOptions * builder: IncrementalBuilder * @@ -358,7 +356,7 @@ type public FSharpCheckFileResults = parseErrors:FSharpDiagnostic[] * keepAssemblyContents: bool * suggestNamesForErrors: bool - -> Async + -> Cancellable /// The result of calling TypeCheckResult including the possibility of abort and background compiler not caught up. and [] public FSharpCheckFileAnswer = @@ -446,7 +444,6 @@ module internal ParseAndCheckFile = type internal FsiInteractiveChecker = internal new: LegacyReferenceResolver * - reactorOps: IReactorOperations * tcConfig: TcConfig * tcGlobals: TcGlobals * tcImports: TcImports * @@ -457,9 +454,8 @@ type internal FsiInteractiveChecker = ctok: CompilationThreadToken * sourceText:ISourceText * ?userOpName: string - -> Async + -> Cancellable module internal FSharpCheckerResultsSettings = val defaultFSharpBinariesDir: string - val maxTimeShareMilliseconds : int64 diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index ea9573d82f7..2a1fadc16b8 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -212,7 +212,7 @@ type BoundModel private (tcConfig: TcConfig, tcGlobals: TcGlobals, tcImports: TcImports, keepAssemblyContents, keepAllBackgroundResolutions, - maxTimeShareMilliseconds, keepAllBackgroundSymbolUses, + keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking, beforeFileChecked: Event, @@ -269,26 +269,26 @@ type BoundModel private (tcConfig: TcConfig, ) member this.GetState(partialCheck: bool) = - let partialCheck = - // Only partial check if we have enabled it. - if enablePartialTypeChecking then partialCheck - else false + eventually { + let partialCheck = + // Only partial check if we have enabled it. + if enablePartialTypeChecking then partialCheck + else false - let mustCheck = - match lazyTcInfoState, partialCheck with - | None, _ -> true - | Some(PartialState _), false -> true - | _ -> false + let mustCheck = + match lazyTcInfoState, partialCheck with + | None, _ -> true + | Some(PartialState _), false -> true + | _ -> false - match lazyTcInfoState with - | Some tcInfoState when not mustCheck -> tcInfoState |> Eventually.Done - | _ -> - lazyTcInfoState <- None - eventually { + match lazyTcInfoState with + | Some tcInfoState when not mustCheck -> return tcInfoState + | _ -> + lazyTcInfoState <- None let! tcInfoState = this.TypeCheck(partialCheck) lazyTcInfoState <- Some tcInfoState return tcInfoState - } + } member this.TryOptionalExtras() = eventually { @@ -308,7 +308,6 @@ type BoundModel private (tcConfig: TcConfig, tcImports, keepAssemblyContents, keepAllBackgroundResolutions, - maxTimeShareMilliseconds, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking, @@ -337,7 +336,6 @@ type BoundModel private (tcConfig: TcConfig, tcImports, keepAssemblyContents, keepAllBackgroundResolutions, - maxTimeShareMilliseconds, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking, @@ -402,121 +400,105 @@ type BoundModel private (tcConfig: TcConfig, IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBETypechecked filename) let capturingErrorLogger = CompilationErrorLogger("TypeCheck", tcConfig.errorSeverityOptions) let errorLogger = GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput input, capturingErrorLogger) - let fullComputation = - eventually { - beforeFileChecked.Trigger filename - let prevModuleNamesDict = prevTcInfo.moduleNamesDict - let prevTcState = prevTcInfo.tcState - let prevTcErrorsRev = prevTcInfo.tcErrorsRev - let prevTcDependencyFiles = prevTcInfo.tcDependencyFiles - - ApplyMetaCommandsFromInputToTcConfig (tcConfig, input, Path.GetDirectoryName filename, tcImports.DependencyProvider) |> ignore - let sink = TcResultsSinkImpl(tcGlobals) - let hadParseErrors = not (Array.isEmpty parseErrors) - let input, moduleNamesDict = DeduplicateParsedInputModuleName prevModuleNamesDict input - - Logger.LogBlockMessageStart filename LogCompilerFunctionId.IncrementalBuild_TypeCheck - let! (tcEnvAtEndOfFile, topAttribs, implFile, ccuSigForFile), tcState = - TypeCheckOneInputEventually - ((fun () -> hadParseErrors || errorLogger.ErrorCount > 0), - tcConfig, tcImports, - tcGlobals, - None, - (if partialCheck then TcResultsSink.NoSink else TcResultsSink.WithSink sink), - prevTcState, input, - partialCheck) - Logger.LogBlockMessageStop filename LogCompilerFunctionId.IncrementalBuild_TypeCheck - - fileChecked.Trigger filename - let newErrors = Array.append parseErrors (capturingErrorLogger.GetDiagnostics()) - - let tcEnvAtEndOfFile = if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls - - let tcInfo = + + beforeFileChecked.Trigger filename + let prevModuleNamesDict = prevTcInfo.moduleNamesDict + let prevTcState = prevTcInfo.tcState + let prevTcErrorsRev = prevTcInfo.tcErrorsRev + let prevTcDependencyFiles = prevTcInfo.tcDependencyFiles + + ApplyMetaCommandsFromInputToTcConfig (tcConfig, input, Path.GetDirectoryName filename, tcImports.DependencyProvider) |> ignore + let sink = TcResultsSinkImpl(tcGlobals) + let hadParseErrors = not (Array.isEmpty parseErrors) + let input, moduleNamesDict = DeduplicateParsedInputModuleName prevModuleNamesDict input + + Logger.LogBlockMessageStart filename LogCompilerFunctionId.IncrementalBuild_TypeCheck + let! (tcEnvAtEndOfFile, topAttribs, implFile, ccuSigForFile), tcState = + TypeCheckOneInputEventually + ((fun () -> hadParseErrors || errorLogger.ErrorCount > 0), + tcConfig, tcImports, + tcGlobals, + None, + (if partialCheck then TcResultsSink.NoSink else TcResultsSink.WithSink sink), + prevTcState, input, + partialCheck) + Logger.LogBlockMessageStop filename LogCompilerFunctionId.IncrementalBuild_TypeCheck + + fileChecked.Trigger filename + let newErrors = Array.append parseErrors (capturingErrorLogger.GetDiagnostics()) + + let tcEnvAtEndOfFile = if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls + + let tcInfo = + { + tcState = tcState + tcEnvAtEndOfFile = tcEnvAtEndOfFile + moduleNamesDict = moduleNamesDict + latestCcuSigForFile = Some ccuSigForFile + tcErrorsRev = newErrors :: prevTcErrorsRev + topAttribs = Some topAttribs + tcDependencyFiles = filename :: prevTcDependencyFiles + sigNameOpt = + match input with + | ParsedInput.SigFile(ParsedSigFileInput(fileName=fileName;qualifiedNameOfFile=qualName)) -> + Some(fileName, qualName) + | _ -> + None + } + + if partialCheck then + return PartialState tcInfo + else + match! prevTcInfoExtras() with + | None -> return PartialState tcInfo + | Some prevTcInfoOptional -> + // Build symbol keys + let itemKeyStore, semanticClassification = + if enableBackgroundItemKeyStoreAndSemanticClassification then + Logger.LogBlockMessageStart filename LogCompilerFunctionId.IncrementalBuild_CreateItemKeyStoreAndSemanticClassification + let sResolutions = sink.GetResolutions() + let builder = ItemKeyStoreBuilder() + let preventDuplicates = HashSet({ new IEqualityComparer with + member _.Equals((s1, e1): struct(pos * pos), (s2, e2): struct(pos * pos)) = Position.posEq s1 s2 && Position.posEq e1 e2 + member _.GetHashCode o = o.GetHashCode() }) + sResolutions.CapturedNameResolutions + |> Seq.iter (fun cnr -> + let r = cnr.Range + if preventDuplicates.Add struct(r.Start, r.End) then + builder.Write(cnr.Range, cnr.Item)) + + let semanticClassification = sResolutions.GetSemanticClassification(tcGlobals, tcImports.GetImportMap(), sink.GetFormatSpecifierLocations(), None) + + let sckBuilder = SemanticClassificationKeyStoreBuilder() + sckBuilder.WriteAll semanticClassification + + let res = builder.TryBuildAndReset(), sckBuilder.TryBuildAndReset() + Logger.LogBlockMessageStop filename LogCompilerFunctionId.IncrementalBuild_CreateItemKeyStoreAndSemanticClassification + res + else + None, None + + let tcInfoExtras = { - tcState = tcState - tcEnvAtEndOfFile = tcEnvAtEndOfFile - moduleNamesDict = moduleNamesDict - latestCcuSigForFile = Some ccuSigForFile - tcErrorsRev = newErrors :: prevTcErrorsRev - topAttribs = Some topAttribs - tcDependencyFiles = filename :: prevTcDependencyFiles - sigNameOpt = - match input with - | ParsedInput.SigFile(ParsedSigFileInput(fileName=fileName;qualifiedNameOfFile=qualName)) -> - Some(fileName, qualName) - | _ -> - None + /// Only keep the typed interface files when doing a "full" build for fsc.exe, otherwise just throw them away + latestImplFile = if keepAssemblyContents then implFile else None + tcResolutionsRev = (if keepAllBackgroundResolutions then sink.GetResolutions() else TcResolutions.Empty) :: prevTcInfoOptional.tcResolutionsRev + tcSymbolUsesRev = (if keepAllBackgroundSymbolUses then sink.GetSymbolUses() else TcSymbolUses.Empty) :: prevTcInfoOptional.tcSymbolUsesRev + tcOpenDeclarationsRev = sink.GetOpenDeclarations() :: prevTcInfoOptional.tcOpenDeclarationsRev + itemKeyStore = itemKeyStore + semanticClassificationKeyStore = semanticClassification } - if partialCheck then - return PartialState tcInfo - else - match! prevTcInfoExtras() with - | None -> return PartialState tcInfo - | Some prevTcInfoOptional -> - // Build symbol keys - let itemKeyStore, semanticClassification = - if enableBackgroundItemKeyStoreAndSemanticClassification then - Logger.LogBlockMessageStart filename LogCompilerFunctionId.IncrementalBuild_CreateItemKeyStoreAndSemanticClassification - let sResolutions = sink.GetResolutions() - let builder = ItemKeyStoreBuilder() - let preventDuplicates = HashSet({ new IEqualityComparer with - member _.Equals((s1, e1): struct(pos * pos), (s2, e2): struct(pos * pos)) = Position.posEq s1 s2 && Position.posEq e1 e2 - member _.GetHashCode o = o.GetHashCode() }) - sResolutions.CapturedNameResolutions - |> Seq.iter (fun cnr -> - let r = cnr.Range - if preventDuplicates.Add struct(r.Start, r.End) then - builder.Write(cnr.Range, cnr.Item)) - - let semanticClassification = sResolutions.GetSemanticClassification(tcGlobals, tcImports.GetImportMap(), sink.GetFormatSpecifierLocations(), None) - - let sckBuilder = SemanticClassificationKeyStoreBuilder() - sckBuilder.WriteAll semanticClassification - - let res = builder.TryBuildAndReset(), sckBuilder.TryBuildAndReset() - Logger.LogBlockMessageStop filename LogCompilerFunctionId.IncrementalBuild_CreateItemKeyStoreAndSemanticClassification - res - else - None, None - - let tcInfoExtras = - { - /// Only keep the typed interface files when doing a "full" build for fsc.exe, otherwise just throw them away - latestImplFile = if keepAssemblyContents then implFile else None - tcResolutionsRev = (if keepAllBackgroundResolutions then sink.GetResolutions() else TcResolutions.Empty) :: prevTcInfoOptional.tcResolutionsRev - tcSymbolUsesRev = (if keepAllBackgroundSymbolUses then sink.GetSymbolUses() else TcSymbolUses.Empty) :: prevTcInfoOptional.tcSymbolUsesRev - tcOpenDeclarationsRev = sink.GetOpenDeclarations() :: prevTcInfoOptional.tcOpenDeclarationsRev - itemKeyStore = itemKeyStore - semanticClassificationKeyStore = semanticClassification - } - - return FullState(tcInfo, tcInfoExtras) - - } + return FullState(tcInfo, tcInfoExtras) - // Run part of the Eventually<_> computation until a timeout is reached. If not complete, - // return a new Eventually<_> computation which recursively runs more of the computation. - // - When the whole thing is finished commit the error results sent through the errorLogger. - // - Each time we do real work we reinstall the CompilationGlobalsScope - let timeSlicedComputation = - fullComputation |> - Eventually.repeatedlyProgressUntilDoneOrTimeShareOverOrCanceled - maxTimeShareMilliseconds - CancellationToken.None - (fun ctok f -> - // Reinstall the compilation globals each time we start or restart - use unwind = new CompilationGlobalsScope (errorLogger, BuildPhase.TypeCheck) - f ctok) - return! timeSlicedComputation + //use unwind = new CompilationGlobalsScope (errorLogger, BuildPhase.TypeCheck) } static member Create(tcConfig: TcConfig, tcGlobals: TcGlobals, tcImports: TcImports, keepAssemblyContents, keepAllBackgroundResolutions, - maxTimeShareMilliseconds, keepAllBackgroundSymbolUses, + keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking, beforeFileChecked: Event, @@ -526,7 +508,7 @@ type BoundModel private (tcConfig: TcConfig, syntaxTreeOpt: SyntaxTree option) = BoundModel(tcConfig, tcGlobals, tcImports, keepAssemblyContents, keepAllBackgroundResolutions, - maxTimeShareMilliseconds, keepAllBackgroundSymbolUses, + keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking, beforeFileChecked, @@ -589,11 +571,6 @@ type FrameworkImportsCache(size) = [] type PartialCheckResults (boundModel: BoundModel, timeStamp: DateTime) = - let eval ctok (work: Eventually<'T>) = - match work with - | Eventually.Done res -> res - | _ -> Eventually.force ctok work - member _.TcImports = boundModel.TcImports member _.TcGlobals = boundModel.TcGlobals @@ -604,17 +581,21 @@ type PartialCheckResults (boundModel: BoundModel, timeStamp: DateTime) = member _.TryTcInfo = boundModel.TryTcInfo - member _.GetTcInfo ctok = boundModel.TcInfo |> eval ctok + member _.GetTcInfo() = boundModel.TcInfo - member _.GetTcInfoWithExtras ctok = boundModel.TcInfoWithExtras |> eval ctok + member _.GetTcInfoWithExtras() = boundModel.TcInfoWithExtras - member _.TryGetItemKeyStore ctok = - let _, info = boundModel.TcInfoWithExtras |> eval ctok - info.itemKeyStore + member _.TryGetItemKeyStore() = + eventually { + let! _, info = boundModel.TcInfoWithExtras + return info.itemKeyStore + } - member _.GetSemanticClassification ctok = - let _, info = boundModel.TcInfoWithExtras |> eval ctok - info.semanticClassificationKeyStore + member _.GetSemanticClassification() = + eventually { + let! _, info = boundModel.TcInfoWithExtras + return info.semanticClassificationKeyStore + } [] module Utilities = @@ -685,7 +666,6 @@ type IncrementalBuilder(tcGlobals, loadClosureOpt: LoadClosure option, keepAssemblyContents, keepAllBackgroundResolutions, - maxTimeShareMilliseconds, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking, @@ -825,7 +805,6 @@ type IncrementalBuilder(tcGlobals, tcImports, keepAssemblyContents, keepAllBackgroundResolutions, - maxTimeShareMilliseconds, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, defaultPartialTypeChecking, @@ -857,22 +836,24 @@ type IncrementalBuilder(tcGlobals, // Get the state at the end of the type-checking of the last file let finalBoundModel = boundModels.[boundModels.Length-1] - let finalInfo = finalBoundModel.TcInfo |> Eventually.force ctok + let! finalInfo = finalBoundModel.TcInfo |> Eventually.toCancellable + + let! results = + boundModels |> Cancellable.each (fun boundModel -> cancellable { + let! tcInfo, latestImplFile = + cancellable { + if enablePartialTypeChecking then + let! tcInfo = boundModel.TcInfo |> Eventually.toCancellable + return tcInfo, None + else + let! tcInfo, tcInfoExtras = boundModel.TcInfoWithExtras |> Eventually.toCancellable + return tcInfo, tcInfoExtras.latestImplFile + } + return (tcInfo.tcEnvAtEndOfFile, defaultArg tcInfo.topAttribs EmptyTopAttrs, latestImplFile, tcInfo.latestCcuSigForFile) + }) // Finish the checking let (_tcEnvAtEndOfLastFile, topAttrs, mimpls, _), tcState = - let results = - boundModels - |> List.ofSeq - |> List.map (fun boundModel -> - let tcInfo, latestImplFile = - if enablePartialTypeChecking then - let tcInfo = boundModel.TcInfo |> Eventually.force ctok - tcInfo, None - else - let tcInfo, tcInfoExtras = boundModel.TcInfoWithExtras |> Eventually.force ctok - tcInfo, tcInfoExtras.latestImplFile - tcInfo.tcEnvAtEndOfFile, defaultArg tcInfo.topAttribs EmptyTopAttrs, latestImplFile, tcInfo.latestCcuSigForFile) TypeCheckMultipleInputsFinish (results, finalInfo.tcState) let ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt = @@ -930,7 +911,7 @@ type IncrementalBuilder(tcGlobals, errorRecoveryNoRange e mkSimpleAssemblyRef assemblyName, None, None - let finalBoundModelWithErrors = finalBoundModel.Finish((errorLogger.GetDiagnostics() :: finalInfo.tcErrorsRev), Some topAttrs) |> Eventually.force ctok + let! finalBoundModelWithErrors = finalBoundModel.Finish((errorLogger.GetDiagnostics() :: finalInfo.tcErrorsRev), Some topAttrs) |> Eventually.toCancellable return ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt, finalBoundModelWithErrors } @@ -1021,66 +1002,59 @@ type IncrementalBuilder(tcGlobals, stampedReferencedAssemblies = stampedReferencedAssemblies.ToImmutable() } - let computeInitialBoundModel (state: IncrementalBuilderState) (ctok: CompilationThreadToken) = - cancellable { + let computeInitialBoundModel (state: IncrementalBuilderState) (ctok: CompilationThreadToken) ct = + eventually { match state.initialBoundModel with | None -> - let! result = CombineImportedAssembliesTask ctok + // Note this can throw an OperationCanceledException, particularly + // for cancellation of the background operation. + let result = CombineImportedAssembliesTask ctok |> Cancellable.runThrowing ct return { state with initialBoundModel = Some result }, result | Some result -> return state, result } - let computeBoundModel state (cache: TimeStampCache) (ctok: CompilationThreadToken) (slot: int) = - if IncrementalBuild.injectCancellationFault then Cancellable.canceled () - else + let computeBoundModel state (cache: TimeStampCache) (ctok: CompilationThreadToken) (ct: CancellationToken) (slot: int) = + eventually { + if IncrementalBuild.injectCancellationFault then + raise (OperationCanceledException()) - cancellable { - let! (state, initial) = computeInitialBoundModel state ctok + let! (state, initial) = computeInitialBoundModel state ctok ct let fileInfo = fileNames.[slot] let state = computeStampedFileName state cache slot fileInfo - let state = - if state.boundModels.[slot].IsNone then - let prevBoundModel = - match slot with - | 0 (* first file *) -> initial - | _ -> - match state.boundModels.[slot - 1] with - | Some(prevBoundModel) -> prevBoundModel - | _ -> - // This shouldn't happen, but on the off-chance, just grab the initial bound model. - initial - - let boundModel = TypeCheckTask ctok state.enablePartialTypeChecking prevBoundModel (ParseTask fileInfo) |> Eventually.force ctok + if state.boundModels.[slot].IsNone then + let prevBoundModel = + match slot with + | 0 (* first file *) -> initial + | _ -> + match state.boundModels.[slot - 1] with + | Some(prevBoundModel) -> prevBoundModel + | _ -> + // This shouldn't happen, but on the off-chance, just grab the initial bound model. + initial + + let! boundModel = TypeCheckTask ctok state.enablePartialTypeChecking prevBoundModel (ParseTask fileInfo) + let state = { state with boundModels = state.boundModels.SetItem(slot, Some boundModel) } - else - state + return state - return state + else + return state } - let computeBoundModels state (cache: TimeStampCache) (ctok: CompilationThreadToken) = - let mutable state = state - let task = - cancellable { - for slot = 0 to fileNames.Length - 1 do - let! newState = computeBoundModel state cache ctok slot - state <- newState - } - cancellable { - let! _ = task - return state - } + let computeBoundModels state (cache: TimeStampCache) (ctok: CompilationThreadToken) ct = + (state, [0..fileNames.Length-1]) ||> Eventually.fold (fun state slot -> computeBoundModel state cache ctok ct slot) let computeFinalizedBoundModel state (cache: TimeStampCache) (ctok: CompilationThreadToken) = cancellable { - let! state = computeBoundModels state cache ctok + let! ct = Cancellable.token() + let! state = computeBoundModels state cache ctok ct |> Eventually.toCancellable match state.finalizedBoundModel with | Some result -> return state, result @@ -1092,14 +1066,14 @@ type IncrementalBuilder(tcGlobals, return { state with finalizedBoundModel = Some result }, result } - let step state (cache: TimeStampCache) (ctok: CompilationThreadToken) = - cancellable { + let populateBoundModel state (cache: TimeStampCache) (ctok: CompilationThreadToken) ct = + eventually { let state = computeStampedReferencedAssemblies state cache let state = computeStampedFileNames state cache match state.boundModels |> Seq.tryFindIndex (fun x -> x.IsNone) with | Some slot -> - let! state = computeBoundModel state cache ctok slot + let! state = computeBoundModel state cache ctok ct slot return state, true | _ -> return state, false @@ -1123,24 +1097,18 @@ type IncrementalBuilder(tcGlobals, None let eval state (cache: TimeStampCache) ctok targetSlot = - if targetSlot < 0 then - cancellable { + cancellable { + let! ct = Cancellable.token() + if targetSlot < 0 then let state = computeStampedReferencedAssemblies state cache - let! state, result = computeInitialBoundModel state ctok + let! state, result = computeInitialBoundModel state ctok ct |> Eventually.toCancellable return state, Some(result, DateTime.MinValue) - } - else - let mutable state = state - let evalUpTo = - cancellable { - for slot = 0 to targetSlot do - let! newState = computeBoundModel state cache ctok slot - state <- newState - } - cancellable { - let newState = computeStampedReferencedAssemblies state cache - state <- newState + else + let evalUpTo = + (state, [0..targetSlot]) ||> Cancellable.fold (fun state slot -> + computeBoundModel state cache ctok ct slot |> Eventually.toCancellable) + let state = computeStampedReferencedAssemblies state cache let! _ = evalUpTo @@ -1151,7 +1119,7 @@ type IncrementalBuilder(tcGlobals, ) return state, result - } + } let tryGetFinalized state cache ctok = cancellable { @@ -1209,16 +1177,13 @@ type IncrementalBuilder(tcGlobals, member _.AllDependenciesDeprecated = allDependencies - member _.Step (ctok: CompilationThreadToken) = - cancellable { + member _.PopulatePartialCheckingResults (ctok: CompilationThreadToken, ct: CancellationToken) = + eventually { let cache = TimeStampCache defaultTimeStamp // One per step - let! state, res = step currentState cache ctok + let! state, res = populateBoundModel currentState cache ctok ct setCurrentState ctok state if not res then projectChecked.Trigger() - return false - else - return true } member builder.GetCheckResultsBeforeFileInProjectEvenIfStale filename: PartialCheckResults option = @@ -1272,7 +1237,7 @@ type IncrementalBuilder(tcGlobals, cancellable { let slotOfFile = builder.GetSlotOfFileName filename + 1 let! result = builder.GetCheckResultsBeforeSlotInProject(ctok, slotOfFile, false) - result.GetTcInfoWithExtras ctok |> ignore // Make sure we forcefully evaluate the info + let! _ = result.GetTcInfoWithExtras() |> Eventually.toCancellable // Make sure we forcefully evaluate the info return result } @@ -1300,7 +1265,7 @@ type IncrementalBuilder(tcGlobals, cancellable { let! result = builder.GetCheckResultsAndImplementationsForProject(ctok, false) let results, _, _, _ = result - results.GetTcInfoWithExtras ctok |> ignore // Make sure we forcefully evaluate the info + let! _ = results.GetTcInfoWithExtras() |> Eventually.toCancellable // Make sure we forcefully evaluate the info return result } @@ -1352,7 +1317,7 @@ type IncrementalBuilder(tcGlobals, commandLineArgs: string list, projectReferences, projectDirectory, useScriptResolutionRules, keepAssemblyContents, - keepAllBackgroundResolutions, maxTimeShareMilliseconds, + keepAllBackgroundResolutions, tryGetMetadataSnapshot, suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, @@ -1501,7 +1466,6 @@ type IncrementalBuilder(tcGlobals, loadClosureOpt, keepAssemblyContents, keepAllBackgroundResolutions, - maxTimeShareMilliseconds, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking, diff --git a/src/fsharp/service/IncrementalBuild.fsi b/src/fsharp/service/IncrementalBuild.fsi index fd6774aa032..57e0393d4ed 100755 --- a/src/fsharp/service/IncrementalBuild.fsi +++ b/src/fsharp/service/IncrementalBuild.fsi @@ -3,6 +3,7 @@ namespace FSharp.Compiler.CodeAnalysis open System +open System.Threading open Internal.Utilities.Library open FSharp.Compiler open FSharp.Compiler.AbstractIL @@ -108,21 +109,21 @@ type internal PartialCheckResults = /// Compute the "TcInfo" part of the results. If `enablePartialTypeChecking` is false then /// extras will also be available. - member GetTcInfo: CompilationThreadToken -> TcInfo + member GetTcInfo: unit -> Eventually /// Compute both the "TcInfo" and "TcInfoExtras" parts of the results. /// Can cause a second type-check if `enablePartialTypeChecking` is true in the checker. /// Only use when it's absolutely necessary to get rich information on a file. - member GetTcInfoWithExtras: CompilationThreadToken -> TcInfo * TcInfoExtras + member GetTcInfoWithExtras: unit -> Eventually /// Compute the "ItemKeyStore" parts of the results. /// Can cause a second type-check if `enablePartialTypeChecking` is true in the checker. /// Only use when it's absolutely necessary to get rich information on a file. - member TryGetItemKeyStore: CompilationThreadToken -> ItemKeyStore option + member TryGetItemKeyStore: unit -> Eventually /// Can cause a second type-check if `enablePartialTypeChecking` is true in the checker. /// Only use when it's absolutely necessary to get rich information on a file. - member GetSemanticClassification: CompilationThreadToken -> SemanticClassificationKeyStore option + member GetSemanticClassification: unit -> Eventually member TimeStamp: DateTime @@ -159,8 +160,8 @@ type internal IncrementalBuilder = /// The list of files the build depends on member AllDependenciesDeprecated : string[] - /// Perform one step in the F# build. Return true if the background work is finished. - member Step : CompilationThreadToken -> Cancellable + /// The project build. Return true if the background work is finished. + member PopulatePartialCheckingResults: CompilationThreadToken * CancellationToken -> Eventually /// Get the preceding typecheck state of a slot, without checking if it is up-to-date w.r.t. /// the timestamps on files and referenced DLLs prior to this one. Return None if the result is not available. @@ -245,7 +246,6 @@ type internal IncrementalBuilder = useScriptResolutionRules:bool * keepAssemblyContents: bool * keepAllBackgroundResolutions: bool * - maxTimeShareMilliseconds: int64 * tryGetMetadataSnapshot: ILBinaryReader.ILReaderTryGetMetadataSnapshot * suggestNamesForErrors: bool * keepAllBackgroundSymbolUses: bool * diff --git a/src/fsharp/service/Reactor.fs b/src/fsharp/service/Reactor.fs index 36a17d9bc84..e89bf4d3fde 100755 --- a/src/fsharp/service/Reactor.fs +++ b/src/fsharp/service/Reactor.fs @@ -18,7 +18,7 @@ type internal IReactorOperations = [] type internal ReactorCommands = /// Kick off a build. - | SetBackgroundOp of ( (* userOpName: *) string * (* opName: *) string * (* opArg: *) string * (CompilationThreadToken -> CancellationToken -> bool)) option + | SetBackgroundOp of ( (* userOpName: *) string * (* opName: *) string * (* opArg: *) string * (CompilationThreadToken -> CancellationToken -> Eventually)) option /// Do some work not synchronized in the mailbox. | Op of userOpName: string * opName: string * opArg: string * CancellationToken * (CompilationThreadToken -> unit) * (unit -> unit) @@ -43,6 +43,16 @@ type Reactor() = let mutable bgOpCts = new CancellationTokenSource() + let sw = new System.Diagnostics.Stopwatch() + + /// Maximum time share for a piece of background work before it should (cooperatively) yield + /// to enable other requests to be serviced. Yielding means returning a continuation function + /// (via an Eventually<_> value of case NotYetDone) that can be called as the next piece of work. + let maxTimeShareMilliseconds = + match System.Environment.GetEnvironmentVariable("FCS_MaxTimeShare") with + | null | "" -> 100L + | s -> int64 s + /// Mailbox dispatch function. let builder = MailboxProcessor<_>.Start <| fun inbox -> @@ -72,6 +82,14 @@ type Reactor() = Thread.CurrentThread.CurrentUICulture <- culture match msg with | Some (SetBackgroundOp bgOpOpt) -> + let bgOpOpt = + match bgOpOpt with + | None -> None + | Some (bgUserOpName, bgOpName, bgOpArg, bgOp) -> + bgOpCts.Dispose() + bgOpCts <- new CancellationTokenSource() + Some (bgUserOpName, bgOpName, bgOpArg, bgOp ctok bgOpCts.Token) + //Trace.TraceInformation("Reactor: --> set background op, remaining {0}", inbox.CurrentQueueLength) return! loop (bgOpOpt, onComplete, false) @@ -88,6 +106,7 @@ type Reactor() = let msg = (if taken > 10000.0 then "BAD-OP: >10s " elif taken > 3000.0 then "BAD-OP: >3s " elif taken > 1000.0 then "BAD-OP: > 1s " elif taken > 500.0 then "BAD-OP: >0.5s " else "") Trace.TraceInformation("Reactor: {0:n3} {1}<-- {2}.{3}, took {4} ms", DateTime.Now.TimeOfDay.TotalSeconds, msg, userOpName, opName, span.TotalMilliseconds) return! loop (bgOpOpt, onComplete, false) + | Some (WaitForBackgroundOpCompletion channel) -> match bgOpOpt with | None -> () @@ -95,8 +114,10 @@ type Reactor() = Trace.TraceInformation("Reactor: {0:n3} --> wait for background {1}.{2} ({3}), remaining {4}", DateTime.Now.TimeOfDay.TotalSeconds, bgUserOpName, bgOpName, bgOpArg, inbox.CurrentQueueLength) bgOpCts.Dispose() bgOpCts <- new CancellationTokenSource() - while not bgOpCts.IsCancellationRequested && bgOp ctok bgOpCts.Token do - () + + try + Eventually.forceCancellable bgOpCts.Token bgOp |> ignore + with :? OperationCanceledException -> () if bgOpCts.IsCancellationRequested then Trace.TraceInformation("FCS: <-- wait for background was cancelled {0}.{1}", bgUserOpName, bgOpName) @@ -111,21 +132,28 @@ type Reactor() = | None -> match bgOpOpt, onComplete with | _, Some onComplete -> onComplete.Reply() - | Some (bgUserOpName, bgOpName, bgOpArg, bgOp), None -> + | Some (bgUserOpName, bgOpName, bgOpArg, bgEv), None -> Trace.TraceInformation("Reactor: {0:n3} --> background step {1}.{2} ({3})", DateTime.Now.TimeOfDay.TotalSeconds, bgUserOpName, bgOpName, bgOpArg) - let time = Stopwatch() - time.Start() - bgOpCts.Dispose() - bgOpCts <- new CancellationTokenSource() - let res = bgOp ctok bgOpCts.Token - if bgOpCts.IsCancellationRequested then - Trace.TraceInformation("FCS: <-- background step {0}.{1}, was cancelled", bgUserOpName, bgOpName) - time.Stop() - let taken = time.Elapsed.TotalMilliseconds + + // Force for a timeslice. Cancellation will either raise + // OperationCanceledException or will result in the partially computed + // suspension. Either way we abandon the background work + let bgOpRes = + try Eventually.forceForTimeSlice sw maxTimeShareMilliseconds bgOpCts.Token bgEv + with :? OperationCanceledException -> Eventually.Done () + + let bgOp2 = + match bgOpRes with + | _ when bgOpCts.IsCancellationRequested -> + Trace.TraceInformation("FCS: <-- background step {0}.{1}, was cancelled", bgUserOpName, bgOpName) + None + | Eventually.Done () -> None + | bgEv2 -> Some (bgUserOpName, bgOpName, bgOpArg, bgEv2) + //if span.TotalMilliseconds > 100.0 then - let msg = (if taken > 10000.0 then "BAD-BG-SLICE: >10s " elif taken > 3000.0 then "BAD-BG-SLICE: >3s " elif taken > 1000.0 then "BAD-BG-SLICE: > 1s " else "") - Trace.TraceInformation("Reactor: {0:n3} {1}<-- background step, took {2}ms", DateTime.Now.TimeOfDay.TotalSeconds, msg, taken) - return! loop ((if res then bgOpOpt else None), onComplete, true) + //let msg = (if taken > 10000.0 then "BAD-BG-SLICE: >10s " elif taken > 3000.0 then "BAD-BG-SLICE: >3s " elif taken > 1000.0 then "BAD-BG-SLICE: > 1s " else "") + //Trace.TraceInformation("Reactor: {0:n3} {1}<-- background step, took {2}ms", DateTime.Now.TimeOfDay.TotalSeconds, msg, taken) + return! loop (bgOp2, onComplete, true) | None, None -> failwith "unreachable, should have used inbox.Receive" } async { diff --git a/src/fsharp/service/Reactor.fsi b/src/fsharp/service/Reactor.fsi index 598e6494ffe..c19a8bd1fb2 100755 --- a/src/fsharp/service/Reactor.fsi +++ b/src/fsharp/service/Reactor.fsi @@ -28,7 +28,8 @@ type internal Reactor = /// Set the background building function, which is called repeatedly /// until it returns 'false'. If None then no background operation is used. - member SetBackgroundOp : ( (* userOpName:*) string * (* opName: *) string * (* opArg: *) string * (CompilationThreadToken -> CancellationToken -> bool)) option -> unit + /// The operation is an Eventually which can be run in time slices. + member SetBackgroundOp : ( (* userOpName:*) string * (* opName: *) string * (* opArg: *) string * (CompilationThreadToken -> CancellationToken -> Eventually)) option -> unit /// Cancel any work being don by the background building function. member CancelBackgroundOp : unit -> unit diff --git a/src/fsharp/service/service.fs b/src/fsharp/service/service.fs index 6375fca5c04..68e91e72680 100644 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -267,7 +267,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC IncrementalBuilder.TryCreateIncrementalBuilderForProjectOptions (ctok, legacyReferenceResolver, FSharpCheckerResultsSettings.defaultFSharpBinariesDir, frameworkTcImportsCache, loadClosure, Array.toList options.SourceFiles, Array.toList options.OtherOptions, projectReferences, options.ProjectDirectory, - options.UseScriptResolutionRules, keepAssemblyContents, keepAllBackgroundResolutions, FSharpCheckerResultsSettings.maxTimeShareMilliseconds, + options.UseScriptResolutionRules, keepAssemblyContents, keepAllBackgroundResolutions, tryGetMetadataSnapshot, suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking, @@ -400,9 +400,8 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC member _.RecordCheckFileInProjectResults(filename,options,parsingOptions,parseResults,fileVersion,priorTimeStamp,checkAnswer,sourceText) = match checkAnswer with - | None - | Some FSharpCheckFileAnswer.Aborted -> () - | Some (FSharpCheckFileAnswer.Succeeded typedResults) -> + | None -> () + | Some typedResults -> foregroundTypeCheckCount <- foregroundTypeCheckCount + 1 parseCacheLock.AcquireLock (fun ltok -> checkFileInProjectCachePossiblyStale.Set(ltok, (filename,options),(parseResults,typedResults,fileVersion)) @@ -481,8 +480,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC builder: IncrementalBuilder, tcPrior: PartialCheckResults, tcInfo: TcInfo, - creationDiags: FSharpDiagnostic[], - userOpName: string) = + creationDiags: FSharpDiagnostic[]) = async { let beingCheckedFileKey = fileName, options, fileVersion @@ -514,8 +512,6 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC tcInfo.moduleNamesDict, loadClosure, tcInfo.TcErrors, - reactorOps, - userOpName, options.IsIncompleteTypeCheckEnvironment, options, builder, @@ -523,11 +519,11 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC creationDiags, parseResults.Diagnostics, keepAssemblyContents, - suggestNamesForErrors) + suggestNamesForErrors) |> Cancellable.toAsync let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, Array.ofList builder.SourceFiles, options.UseScriptResolutionRules) reactor.SetPreferredUILang tcConfig.preferredUiLang bc.RecordCheckFileInProjectResults(fileName, options, parsingOptions, parseResults, fileVersion, tcPrior.TimeStamp, Some checkAnswer, sourceText.GetHashCode()) - return checkAnswer + return FSharpCheckFileAnswer.Succeeded checkAnswer finally let dummy = ref () beingCheckedFileTable.TryRemove(beingCheckedFileKey, dummy) |> ignore @@ -576,7 +572,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC match tcPrior with | Some(tcPrior, tcInfo) -> - let! checkResults = bc.CheckOneFileImpl(parseResults, sourceText, filename, options, fileVersion, builder, tcPrior, tcInfo, creationDiags, userOpName) + let! checkResults = bc.CheckOneFileImpl(parseResults, sourceText, filename, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) return Some checkResults | None -> return None // the incremental builder was not up to date finally @@ -611,9 +607,10 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC execWithReactorAsync <| fun ctok -> cancellable { let! tcPrior = builder.GetCheckResultsBeforeFileInProject (ctok, filename) - return (tcPrior, tcPrior.GetTcInfo ctok) + let! tcInfo = tcPrior.GetTcInfo() |> Eventually.toCancellable + return (tcPrior, tcInfo) } - let! checkAnswer = bc.CheckOneFileImpl(parseResults, sourceText, filename, options, fileVersion, builder, tcPrior, tcInfo, creationDiags, userOpName) + let! checkAnswer = bc.CheckOneFileImpl(parseResults, sourceText, filename, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) return checkAnswer finally bc.ImplicitlyStartCheckProjectInBackground(options, userOpName) @@ -660,7 +657,8 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC execWithReactorAsync <| fun ctok -> cancellable { let! tcPrior = builder.GetCheckResultsBeforeFileInProject (ctok, filename) - return (tcPrior, tcPrior.GetTcInfo ctok) + let! tcInfo = tcPrior.GetTcInfo() |> Eventually.toCancellable + return (tcPrior, tcInfo) } // Do the parsing. @@ -668,7 +666,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC reactor.SetPreferredUILang tcPrior.TcConfig.preferredUiLang let parseDiags, parseTree, anyErrors = ParseAndCheckFile.parseFile (sourceText, filename, parsingOptions, userOpName, suggestNamesForErrors) let parseResults = FSharpParseFileResults(parseDiags, parseTree, anyErrors, builder.AllDependenciesDeprecated) - let! checkResults = bc.CheckOneFileImpl(parseResults, sourceText, filename, options, fileVersion, builder, tcPrior, tcInfo, creationDiags, userOpName) + let! checkResults = bc.CheckOneFileImpl(parseResults, sourceText, filename, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) Logger.LogBlockMessageStop (filename + strGuid + "-Successful") LogCompilerFunctionId.Service_ParseAndCheckFileInProject @@ -692,7 +690,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC let (parseTree, _, _, parseDiags) = builder.GetParseResultsForFile (filename) let! tcProj = builder.GetFullCheckResultsAfterFileInProject (ctok, filename) - let tcInfo, tcInfoExtras = tcProj.GetTcInfoWithExtras ctok + let! tcInfo, tcInfoExtras = tcProj.GetTcInfoWithExtras() |> Eventually.toCancellable let tcResolutionsRev = tcInfoExtras.tcResolutionsRev let tcSymbolUsesRev = tcInfoExtras.tcSymbolUsesRev @@ -739,17 +737,19 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC member _.FindReferencesInFile(filename: string, options: FSharpProjectOptions, symbol: FSharpSymbol, canInvalidateProject: bool, userOpName: string) = reactor.EnqueueAndAwaitOpAsync(userOpName, "FindReferencesInFile", filename, fun ctok -> cancellable { - let! builderOpt, _ = getOrCreateBuilderWithInvalidationFlag (ctok, options, canInvalidateProject, userOpName) - match builderOpt with - | None -> return Seq.empty - | Some builder -> - if builder.ContainsFile filename then - let! checkResults = builder.GetFullCheckResultsAfterFileInProject (ctok, filename) - match checkResults.TryGetItemKeyStore ctok with - | None -> return Seq.empty - | Some reader -> return reader.FindAll symbol.Item - else - return Seq.empty }) + let! builderOpt, _ = getOrCreateBuilderWithInvalidationFlag (ctok, options, canInvalidateProject, userOpName) + match builderOpt with + | None -> return Seq.empty + | Some builder -> + if builder.ContainsFile filename then + let! checkResults = builder.GetFullCheckResultsAfterFileInProject (ctok, filename) + let! keyStoreOpt = checkResults.TryGetItemKeyStore() |> Eventually.toCancellable + match keyStoreOpt with + | None -> return Seq.empty + | Some reader -> return reader.FindAll symbol.Item + else + return Seq.empty + }) member _.GetSemanticClassificationForFile(filename: string, options: FSharpProjectOptions, userOpName: string) = @@ -760,7 +760,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC | None -> return None | Some builder -> let! checkResults = builder.GetFullCheckResultsAfterFileInProject (ctok, filename) - let scopt = checkResults.GetSemanticClassification ctok + let! scopt = checkResults.GetSemanticClassification() |> Eventually.toCancellable match scopt with | None -> return None | Some sc -> return Some (sc.GetView ()) }) @@ -787,7 +787,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC let errorOptions = tcProj.TcConfig.errorSeverityOptions let fileName = TcGlobals.DummyFileNameForRangesWithoutASpecificLocation - let tcInfo, tcInfoExtras = tcProj.GetTcInfoWithExtras ctok + let! tcInfo, tcInfoExtras = tcProj.GetTcInfoWithExtras() |> Eventually.toCancellable let tcSymbolUses = tcInfoExtras.TcSymbolUses let topAttribs = tcInfo.topAttribs @@ -935,17 +935,15 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC member _.CheckProjectInBackground (options, userOpName) = reactor.SetBackgroundOp (Some (userOpName, "CheckProjectInBackground", options.ProjectFileName, (fun ctok ct -> - // The creation of the background builder can't currently be cancelled - match getOrCreateBuilder (ctok, options, userOpName) |> Cancellable.run ct with - | ValueOrCancelled.Cancelled _ -> false - | ValueOrCancelled.Value (builderOpt,_) -> + eventually { + // Builder creation is not yet time-sliced. + // Note the background op is allowed to throw OperationCanceledException. + let builderOpt,_ = getOrCreateBuilder (ctok, options, userOpName) |> Cancellable.runThrowing ct match builderOpt with - | None -> false + | None -> return () | Some builder -> - // The individual steps of the background build - match builder.Step(ctok) |> Cancellable.run ct with - | ValueOrCancelled.Value v -> v - | ValueOrCancelled.Cancelled _ -> false))) + return! builder.PopulatePartialCheckingResults (ctok, ct) + }))) member _.StopBackgroundCompile () = reactor.SetBackgroundOp(None) From d4b1f0060a683bb7c51138fe24a66314e0d7d60e Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 26 Feb 2021 00:58:45 +0000 Subject: [PATCH 03/15] eventually/cancellable cleanup --- src/fsharp/ParseAndCheckInputs.fs | 5 +- src/fsharp/absil/illib.fs | 96 +++++++++---------- src/fsharp/absil/illib.fsi | 38 ++++---- src/fsharp/service/IncrementalBuild.fs | 34 +++---- src/fsharp/service/IncrementalBuild.fsi | 2 +- src/fsharp/service/Reactor.fs | 15 ++- src/fsharp/service/Reactor.fsi | 2 +- src/fsharp/service/service.fs | 21 ++-- .../SurfaceArea.netstandard.fs | 2 +- tests/FSharp.Test.Utilities/ScriptHelpers.fs | 2 +- 10 files changed, 105 insertions(+), 112 deletions(-) diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index a0a26f346aa..252f127f72f 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -827,7 +827,10 @@ let TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, pre RequireCompilationThread ctok TypeCheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, inp, false) - |> Eventually.force + |> Eventually.force CancellationToken.None + |> function + | ValueOrCancelled.Value v -> v + | ValueOrCancelled.Cancelled ce -> raise ce // this condition is unexpected, since CancellationToken.None was passed /// Finish checking multiple files (or one interactive entry into F# Interactive) let TypeCheckMultipleInputsFinish(results, tcState: TcState) = diff --git a/src/fsharp/absil/illib.fs b/src/fsharp/absil/illib.fs index c2d536c3b7a..7aaea788918 100644 --- a/src/fsharp/absil/illib.fs +++ b/src/fsharp/absil/illib.fs @@ -676,9 +676,10 @@ type Lock<'LockTokenType when 'LockTokenType :> LockToken>() = module Map = let tryFindMulti k map = match Map.tryFind k map with Some res -> res | None -> [] +[] type ResultOrException<'TResult> = - | Result of 'TResult - | Exception of Exception + | Result of result: 'TResult + | Exception of ``exception``: Exception module ResultOrException = @@ -702,10 +703,10 @@ module ResultOrException = | Result x -> success x | Exception _err -> f() -[] +[] type ValueOrCancelled<'TResult> = - | Value of 'TResult - | Cancelled of OperationCanceledException + | Value of result: 'TResult + | Cancelled of ``exception``: OperationCanceledException /// Represents a cancellable computation with explicit representation of a cancelled result. /// @@ -721,19 +722,7 @@ module Cancellable = if ct.IsCancellationRequested then ValueOrCancelled.Cancelled (OperationCanceledException ct) else - try oper ct - with - | :? OperationCanceledException as e -> - ValueOrCancelled.Cancelled e - | _ -> reraise() - - let runThrowing (ct: CancellationToken) (Cancellable oper) = - if ct.IsCancellationRequested then - raise (OperationCanceledException ct) - else - match oper ct with - | ValueOrCancelled.Cancelled ce -> raise ce - | ValueOrCancelled.Value v -> v + oper ct /// Bind the result of a cancellable computation let bind f comp1 = @@ -864,14 +853,18 @@ module CancellableAutoOpens = /// - Cancellation results in a suspended computation rather than complete abandonment type Eventually<'T> = | Done of 'T - | NotYetDone of (unit -> Eventually<'T>) + | NotYetDone of (CancellationToken -> ValueOrCancelled>) module Eventually = let rec map f e = match e with | Done x -> Done (f x) - | NotYetDone work -> NotYetDone (fun ct -> map f (work ct)) + | NotYetDone work -> + NotYetDone (fun ct -> + match work ct with + | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce + | ValueOrCancelled.Value e2 -> ValueOrCancelled.Value (map f e2)) let box e = map Operators.box e @@ -884,49 +877,51 @@ module Eventually = if ct.IsCancellationRequested then ValueOrCancelled.Cancelled (OperationCanceledException ct) else - loop (work()) + match work ct with + | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce + | ValueOrCancelled.Value e2 -> loop e2 loop e) - let forceCancellable ct e = Cancellable.run ct (toCancellable e) + let ofCancellable (Cancellable f) = + NotYetDone (fun ct -> + match f ct with + | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce + | ValueOrCancelled.Value v -> ValueOrCancelled.Value (Done v) + ) + + let token () = NotYetDone (fun ct -> ValueOrCancelled.Value (Done ct)) - let forceCancellableThrowing ct e = Cancellable.runThrowing ct (toCancellable e) + let canceled () = NotYetDone (fun ct -> ValueOrCancelled.Cancelled (OperationCanceledException ct)) - let rec force e = - match e with - | Done x -> x - | NotYetDone work -> force (work()) + let force ct e = Cancellable.run ct (toCancellable e) let forceForTimeSlice (sw: Stopwatch) timeShareInMilliseconds (ct: CancellationToken) e = sw.Reset() sw.Start() - let rec loop ev2 = - match ev2 with - | Done _ -> ev2 + let rec loop e = + match e with + | Done _ -> ValueOrCancelled.Value e | NotYetDone work -> - if ct.IsCancellationRequested || sw.ElapsedMilliseconds > timeShareInMilliseconds then + if ct.IsCancellationRequested then sw.Stop() - ev2 + ValueOrCancelled.Cancelled (OperationCanceledException(ct)) + elif sw.ElapsedMilliseconds > timeShareInMilliseconds then + sw.Stop() + ValueOrCancelled.Value e else - loop (work()) - loop e - - /// Keep running the asynchronous computation bit by bit. The runner gets called each time the computation is restarted. - /// Can be cancelled as an Async in the normal way. - let forceAsync (runner: (unit -> Eventually<'T>) -> Async>) (e: Eventually<'T>) : Async<'T> = - let rec loop (e: Eventually<'T>) = - async { - match e with - | Done x -> return x - | NotYetDone work -> - let! r = runner work - return! loop r - } + match work ct with + | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce + | ValueOrCancelled.Value e2 -> loop e2 loop e let rec bind k e = match e with | Done x -> k x - | NotYetDone work -> NotYetDone (fun ct -> bind k (work ct)) + | NotYetDone work -> + NotYetDone (fun ct -> + match work ct with + | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce + | ValueOrCancelled.Value e2 -> ValueOrCancelled.Value (bind k e2)) let fold f acc seq = (Done acc, seq) ||> Seq.fold (fun acc x -> acc |> bind (fun acc -> f acc x)) @@ -938,10 +933,11 @@ module Eventually = NotYetDone (fun ct -> let res = try Result(work ct) with | e -> Exception e match res with - | Result cont -> catch cont - | Exception e -> Done(Exception e)) + | Result (ValueOrCancelled.Value cont) -> ValueOrCancelled.Value (catch cont) + | Result (ValueOrCancelled.Cancelled ce) -> ValueOrCancelled.Cancelled ce + | Exception e -> ValueOrCancelled.Value (Done(Exception e))) - let delay (f: unit -> Eventually<'T>) = NotYetDone (fun _ctok -> f()) + let delay f = NotYetDone (fun _ct -> ValueOrCancelled.Value (f ())) let tryFinally e compensation = catch e diff --git a/src/fsharp/absil/illib.fsi b/src/fsharp/absil/illib.fsi index cbc034cf653..e0e0286c677 100644 --- a/src/fsharp/absil/illib.fsi +++ b/src/fsharp/absil/illib.fsi @@ -323,9 +323,10 @@ module internal Map = val tryFindMulti : k:'a -> map:Map<'a,'b list> -> 'b list when 'a: comparison +[] type internal ResultOrException<'TResult> = - | Result of 'TResult - | Exception of Exception + | Result of result: 'TResult + | Exception of ``exception``: Exception module internal ResultOrException = @@ -339,10 +340,10 @@ module internal ResultOrException = val otherwise : f:(unit -> ResultOrException<'a>) -> x:ResultOrException<'a> -> ResultOrException<'a> -[] +[] type internal ValueOrCancelled<'TResult> = - | Value of 'TResult - | Cancelled of OperationCanceledException + | Value of result: 'TResult + | Cancelled of ``exception``: OperationCanceledException /// Represents a synchronous cancellable computation with explicit representation of a cancelled result. /// @@ -357,10 +358,6 @@ module internal Cancellable = /// Run a cancellable computation using the given cancellation token val run : ct:CancellationToken -> Cancellable<'a> -> ValueOrCancelled<'a> - /// Run a cancellable computation using the given cancellation token. Raise OperationCanceledException - /// if cancellation occurs - val runThrowing : ct:CancellationToken -> Cancellable<'a> -> 'a - /// Bind the result of a cancellable computation val bind : f:('a -> Cancellable<'b>) -> comp1:Cancellable<'a> -> Cancellable<'b> @@ -425,7 +422,7 @@ type internal CancellableBuilder = module internal CancellableAutoOpens = val cancellable: CancellableBuilder -/// Computations that can cooperatively yield by returning a continuation +/// Cancellable computations that can cooperatively yield by returning a continuation /// /// - Any yield of a NotYetDone should typically be "abandonable" without adverse consequences. No resource release /// will be called when the computation is abandoned. @@ -437,28 +434,23 @@ module internal CancellableAutoOpens = /// Eventually.forceForTimeSlice type internal Eventually<'T> = | Done of 'T - | NotYetDone of (unit -> Eventually<'T>) + | NotYetDone of (CancellationToken -> ValueOrCancelled>) module internal Eventually = val box: e:Eventually<'a> -> Eventually + // Throws away time-slicing but retains cancellation val toCancellable: e:Eventually<'a> -> Cancellable<'a> - val force: e:Eventually<'a> -> 'a + val ofCancellable: Cancellable<'T> -> Eventually<'T> - val forceCancellable: ct: CancellationToken -> e:Eventually<'a> -> ValueOrCancelled<'a> - - val forceCancellableThrowing: ct: CancellationToken -> e:Eventually<'a> -> 'a + val force: ct: CancellationToken -> e:Eventually<'a> -> ValueOrCancelled<'a> /// Run for at most the given time slice, returning the residue computation, which may be complete. /// If cancellation is requested then just return the computation at the point where cancellation /// was detected. - val forceForTimeSlice: sw:Stopwatch -> timeShareInMilliseconds: int64 -> ct: CancellationToken -> e: Eventually<'b> -> Eventually<'b> - - /// Keep running the asynchronous computation bit by bit. The runner gets called each time the computation is restarted. - /// Can be cancelled as an Async in the normal way. If cancelled the partially computed computation is lost - val forceAsync: runner:((unit -> Eventually<'T>) -> Async>) -> e:Eventually<'T> -> Async<'T> + val forceForTimeSlice: sw:Stopwatch -> timeShareInMilliseconds: int64 -> ct: CancellationToken -> e: Eventually<'a> -> ValueOrCancelled> val bind: k:('a -> Eventually<'b>) -> e:Eventually<'a> -> Eventually<'b> @@ -472,6 +464,12 @@ module internal Eventually = val tryWith : e:Eventually<'a> -> handler:(System.Exception -> Eventually<'a>) -> Eventually<'a> + /// Bind the cancellation token associated with the computation + val token: unit -> Eventually + + /// Represents a canceled computation + val canceled: unit -> Eventually<'a> + [] type internal EventuallyBuilder = diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 2a1fadc16b8..c4bc0631814 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -1002,24 +1002,22 @@ type IncrementalBuilder(tcGlobals, stampedReferencedAssemblies = stampedReferencedAssemblies.ToImmutable() } - let computeInitialBoundModel (state: IncrementalBuilderState) (ctok: CompilationThreadToken) ct = + let computeInitialBoundModel (state: IncrementalBuilderState) (ctok: CompilationThreadToken) = eventually { match state.initialBoundModel with | None -> - // Note this can throw an OperationCanceledException, particularly - // for cancellation of the background operation. - let result = CombineImportedAssembliesTask ctok |> Cancellable.runThrowing ct + // Note this is not time-sliced + let! result = CombineImportedAssembliesTask ctok |> Eventually.ofCancellable return { state with initialBoundModel = Some result }, result | Some result -> return state, result } - let computeBoundModel state (cache: TimeStampCache) (ctok: CompilationThreadToken) (ct: CancellationToken) (slot: int) = + let computeBoundModel state (cache: TimeStampCache) (ctok: CompilationThreadToken) (slot: int) = + if IncrementalBuild.injectCancellationFault then Eventually.canceled() else eventually { - if IncrementalBuild.injectCancellationFault then - raise (OperationCanceledException()) - let! (state, initial) = computeInitialBoundModel state ctok ct + let! (state, initial) = computeInitialBoundModel state ctok let fileInfo = fileNames.[slot] @@ -1048,13 +1046,12 @@ type IncrementalBuilder(tcGlobals, return state } - let computeBoundModels state (cache: TimeStampCache) (ctok: CompilationThreadToken) ct = - (state, [0..fileNames.Length-1]) ||> Eventually.fold (fun state slot -> computeBoundModel state cache ctok ct slot) + let computeBoundModels state (cache: TimeStampCache) (ctok: CompilationThreadToken) = + (state, [0..fileNames.Length-1]) ||> Eventually.fold (fun state slot -> computeBoundModel state cache ctok slot) let computeFinalizedBoundModel state (cache: TimeStampCache) (ctok: CompilationThreadToken) = cancellable { - let! ct = Cancellable.token() - let! state = computeBoundModels state cache ctok ct |> Eventually.toCancellable + let! state = computeBoundModels state cache ctok |> Eventually.toCancellable match state.finalizedBoundModel with | Some result -> return state, result @@ -1066,14 +1063,14 @@ type IncrementalBuilder(tcGlobals, return { state with finalizedBoundModel = Some result }, result } - let populateBoundModel state (cache: TimeStampCache) (ctok: CompilationThreadToken) ct = + let populateBoundModel state (cache: TimeStampCache) (ctok: CompilationThreadToken) = eventually { let state = computeStampedReferencedAssemblies state cache let state = computeStampedFileNames state cache match state.boundModels |> Seq.tryFindIndex (fun x -> x.IsNone) with | Some slot -> - let! state = computeBoundModel state cache ctok ct slot + let! state = computeBoundModel state cache ctok slot return state, true | _ -> return state, false @@ -1098,16 +1095,15 @@ type IncrementalBuilder(tcGlobals, let eval state (cache: TimeStampCache) ctok targetSlot = cancellable { - let! ct = Cancellable.token() if targetSlot < 0 then let state = computeStampedReferencedAssemblies state cache - let! state, result = computeInitialBoundModel state ctok ct |> Eventually.toCancellable + let! state, result = computeInitialBoundModel state ctok |> Eventually.toCancellable return state, Some(result, DateTime.MinValue) else let evalUpTo = (state, [0..targetSlot]) ||> Cancellable.fold (fun state slot -> - computeBoundModel state cache ctok ct slot |> Eventually.toCancellable) + computeBoundModel state cache ctok slot |> Eventually.toCancellable) let state = computeStampedReferencedAssemblies state cache let! _ = evalUpTo @@ -1177,10 +1173,10 @@ type IncrementalBuilder(tcGlobals, member _.AllDependenciesDeprecated = allDependencies - member _.PopulatePartialCheckingResults (ctok: CompilationThreadToken, ct: CancellationToken) = + member _.PopulatePartialCheckingResults (ctok: CompilationThreadToken) = eventually { let cache = TimeStampCache defaultTimeStamp // One per step - let! state, res = populateBoundModel currentState cache ctok ct + let! state, res = populateBoundModel currentState cache ctok setCurrentState ctok state if not res then projectChecked.Trigger() diff --git a/src/fsharp/service/IncrementalBuild.fsi b/src/fsharp/service/IncrementalBuild.fsi index 57e0393d4ed..bcaa09b9422 100755 --- a/src/fsharp/service/IncrementalBuild.fsi +++ b/src/fsharp/service/IncrementalBuild.fsi @@ -161,7 +161,7 @@ type internal IncrementalBuilder = member AllDependenciesDeprecated : string[] /// The project build. Return true if the background work is finished. - member PopulatePartialCheckingResults: CompilationThreadToken * CancellationToken -> Eventually + member PopulatePartialCheckingResults: CompilationThreadToken -> Eventually /// Get the preceding typecheck state of a slot, without checking if it is up-to-date w.r.t. /// the timestamps on files and referenced DLLs prior to this one. Return None if the result is not available. diff --git a/src/fsharp/service/Reactor.fs b/src/fsharp/service/Reactor.fs index e89bf4d3fde..68fe32a698e 100755 --- a/src/fsharp/service/Reactor.fs +++ b/src/fsharp/service/Reactor.fs @@ -18,7 +18,7 @@ type internal IReactorOperations = [] type internal ReactorCommands = /// Kick off a build. - | SetBackgroundOp of ( (* userOpName: *) string * (* opName: *) string * (* opArg: *) string * (CompilationThreadToken -> CancellationToken -> Eventually)) option + | SetBackgroundOp of ( (* userOpName: *) string * (* opName: *) string * (* opArg: *) string * (CompilationThreadToken -> Eventually)) option /// Do some work not synchronized in the mailbox. | Op of userOpName: string * opName: string * opArg: string * CancellationToken * (CompilationThreadToken -> unit) * (unit -> unit) @@ -88,7 +88,7 @@ type Reactor() = | Some (bgUserOpName, bgOpName, bgOpArg, bgOp) -> bgOpCts.Dispose() bgOpCts <- new CancellationTokenSource() - Some (bgUserOpName, bgOpName, bgOpArg, bgOp ctok bgOpCts.Token) + Some (bgUserOpName, bgOpName, bgOpArg, bgOp ctok) //Trace.TraceInformation("Reactor: --> set background op, remaining {0}", inbox.CurrentQueueLength) return! loop (bgOpOpt, onComplete, false) @@ -116,7 +116,7 @@ type Reactor() = bgOpCts <- new CancellationTokenSource() try - Eventually.forceCancellable bgOpCts.Token bgOp |> ignore + Eventually.force bgOpCts.Token bgOp |> ignore with :? OperationCanceledException -> () if bgOpCts.IsCancellationRequested then @@ -135,12 +135,11 @@ type Reactor() = | Some (bgUserOpName, bgOpName, bgOpArg, bgEv), None -> Trace.TraceInformation("Reactor: {0:n3} --> background step {1}.{2} ({3})", DateTime.Now.TimeOfDay.TotalSeconds, bgUserOpName, bgOpName, bgOpArg) - // Force for a timeslice. Cancellation will either raise - // OperationCanceledException or will result in the partially computed - // suspension. Either way we abandon the background work + // Force for a timeslice. If cancellation occurs we abandon the background work. let bgOpRes = - try Eventually.forceForTimeSlice sw maxTimeShareMilliseconds bgOpCts.Token bgEv - with :? OperationCanceledException -> Eventually.Done () + match Eventually.forceForTimeSlice sw maxTimeShareMilliseconds bgOpCts.Token bgEv with + | ValueOrCancelled.Value cont -> cont + | ValueOrCancelled.Cancelled _ -> Eventually.Done () let bgOp2 = match bgOpRes with diff --git a/src/fsharp/service/Reactor.fsi b/src/fsharp/service/Reactor.fsi index c19a8bd1fb2..f17caccc0ee 100755 --- a/src/fsharp/service/Reactor.fsi +++ b/src/fsharp/service/Reactor.fsi @@ -29,7 +29,7 @@ type internal Reactor = /// Set the background building function, which is called repeatedly /// until it returns 'false'. If None then no background operation is used. /// The operation is an Eventually which can be run in time slices. - member SetBackgroundOp : ( (* userOpName:*) string * (* opName: *) string * (* opArg: *) string * (CompilationThreadToken -> CancellationToken -> Eventually)) option -> unit + member SetBackgroundOp : ( (* userOpName:*) string * (* opName: *) string * (* opArg: *) string * (CompilationThreadToken -> Eventually)) option -> unit /// Cancel any work being don by the background building function. member CancelBackgroundOp : unit -> unit diff --git a/src/fsharp/service/service.fs b/src/fsharp/service/service.fs index 68e91e72680..1275eab9aea 100644 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -934,16 +934,17 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC }) member _.CheckProjectInBackground (options, userOpName) = - reactor.SetBackgroundOp (Some (userOpName, "CheckProjectInBackground", options.ProjectFileName, (fun ctok ct -> - eventually { - // Builder creation is not yet time-sliced. - // Note the background op is allowed to throw OperationCanceledException. - let builderOpt,_ = getOrCreateBuilder (ctok, options, userOpName) |> Cancellable.runThrowing ct - match builderOpt with - | None -> return () - | Some builder -> - return! builder.PopulatePartialCheckingResults (ctok, ct) - }))) + reactor.SetBackgroundOp + (Some(userOpName, "CheckProjectInBackground", options.ProjectFileName, + (fun ctok -> + eventually { + // Builder creation is not yet time-sliced. + let! builderOpt,_ = getOrCreateBuilder (ctok, options, userOpName) |> Eventually.ofCancellable + match builderOpt with + | None -> return () + | Some builder -> + return! builder.PopulatePartialCheckingResults (ctok) + }))) member _.StopBackgroundCompile () = reactor.SetBackgroundOp(None) diff --git a/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs b/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs index ad4eb78ab85..19729206812 100644 --- a/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs +++ b/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs @@ -3512,7 +3512,6 @@ FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: FsiEvaluationSessionHost FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: FsiEvaluationSessionHostConfig GetDefaultConfiguration(System.Object) FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: FsiEvaluationSessionHostConfig GetDefaultConfiguration(System.Object, Boolean) FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Interactive.Shell+FsiBoundValue] GetBoundValues() -FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Microsoft.FSharp.Control.FSharpAsync`1[System.Tuple`3[FSharp.Compiler.CodeAnalysis.FSharpParseFileResults,FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults,FSharp.Compiler.CodeAnalysis.FSharpCheckProjectResults]] ParseAndCheckInteraction(System.String) FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Microsoft.FSharp.Control.IEvent`2[Microsoft.FSharp.Control.FSharpHandler`1[Microsoft.FSharp.Core.Unit],Microsoft.FSharp.Core.Unit] PartialAssemblySignatureUpdated FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Microsoft.FSharp.Control.IEvent`2[Microsoft.FSharp.Control.FSharpHandler`1[Microsoft.FSharp.Core.Unit],Microsoft.FSharp.Core.Unit] get_PartialAssemblySignatureUpdated() FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Microsoft.FSharp.Control.IEvent`2[Microsoft.FSharp.Control.FSharpHandler`1[System.Tuple`3[System.Object,System.Type,System.String]],System.Tuple`3[System.Object,System.Type,System.String]] ValueBound @@ -3528,6 +3527,7 @@ FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: System.String FormatValu FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: System.Tuple`2[Microsoft.FSharp.Core.FSharpChoice`2[Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Interactive.Shell+FsiValue],System.Exception],FSharp.Compiler.Diagnostics.FSharpDiagnostic[]] EvalExpressionNonThrowing(System.String) FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: System.Tuple`2[Microsoft.FSharp.Core.FSharpChoice`2[Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Interactive.Shell+FsiValue],System.Exception],FSharp.Compiler.Diagnostics.FSharpDiagnostic[]] EvalInteractionNonThrowing(System.String, Microsoft.FSharp.Core.FSharpOption`1[System.Threading.CancellationToken]) FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: System.Tuple`2[Microsoft.FSharp.Core.FSharpChoice`2[Microsoft.FSharp.Core.Unit,System.Exception],FSharp.Compiler.Diagnostics.FSharpDiagnostic[]] EvalScriptNonThrowing(System.String) +FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: System.Tuple`3[FSharp.Compiler.CodeAnalysis.FSharpParseFileResults,FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults,FSharp.Compiler.CodeAnalysis.FSharpCheckProjectResults] ParseAndCheckInteraction(System.String) FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Void AddBoundValue(System.String, System.Object) FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Void EvalInteraction(System.String, Microsoft.FSharp.Core.FSharpOption`1[System.Threading.CancellationToken]) FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Void EvalScript(System.String) diff --git a/tests/FSharp.Test.Utilities/ScriptHelpers.fs b/tests/FSharp.Test.Utilities/ScriptHelpers.fs index 1d169d6692a..afb592b8c72 100644 --- a/tests/FSharp.Test.Utilities/ScriptHelpers.fs +++ b/tests/FSharp.Test.Utilities/ScriptHelpers.fs @@ -122,7 +122,7 @@ type FSharpScript(?additionalArgs: string[], ?quiet: bool, ?langVersion: LangVer /// The 0-based column index member _.GetCompletionItems(text: string, line: int, column: int) = async { - let! parseResults, checkResults, _projectResults = fsi.ParseAndCheckInteraction(text) + let parseResults, checkResults, _projectResults = fsi.ParseAndCheckInteraction(text) let lineText = text.Split('\n').[line - 1] let partialName = QuickParse.GetPartialLongNameEx(lineText, column - 1) let declarationListInfos = checkResults.GetDeclarationListInfo(Some parseResults, line, lineText, partialName) From e9cc3a4ae5823dfd36b63ba2632c451dbe036138 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 26 Feb 2021 01:06:50 +0000 Subject: [PATCH 04/15] eventually/cancellable cleanup --- src/fsharp/service/IncrementalBuild.fs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index c4bc0631814..202014a14d3 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -1101,13 +1101,11 @@ type IncrementalBuilder(tcGlobals, let! state, result = computeInitialBoundModel state ctok |> Eventually.toCancellable return state, Some(result, DateTime.MinValue) else - let evalUpTo = + let! state = (state, [0..targetSlot]) ||> Cancellable.fold (fun state slot -> computeBoundModel state cache ctok slot |> Eventually.toCancellable) let state = computeStampedReferencedAssemblies state cache - let! _ = evalUpTo - let result = state.boundModels.[targetSlot] |> Option.map (fun boundModel -> From 0f134f2be6fff28a2a967bb7355fd661959cded4 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 26 Feb 2021 01:38:29 +0000 Subject: [PATCH 05/15] fix error regressions --- src/fsharp/fsc.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index ec8a2720f33..3c2dce50b12 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -83,7 +83,7 @@ type ErrorLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, nameFo x.HandleTooManyErrors(FSComp.SR.fscTooManyErrors()) exiter.Exit 1 - x.HandleIssue(tcConfigB, err, severity) + x.HandleIssue(tcConfigB, err, FSharpDiagnosticSeverity.Error) errors <- errors + 1 From 6c22227b23c30d4ca1df4c1132b1b3f52a72035c Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 1 Mar 2021 14:14:58 +0000 Subject: [PATCH 06/15] comments --- src/fsharp/service/IncrementalBuild.fs | 2 -- src/fsharp/symbols/SymbolHelpers.fs | 2 +- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 202014a14d3..0d11d5ab12e 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -490,8 +490,6 @@ type BoundModel private (tcConfig: TcConfig, } return FullState(tcInfo, tcInfoExtras) - - //use unwind = new CompilationGlobalsScope (errorLogger, BuildPhase.TypeCheck) } static member Create(tcConfig: TcConfig, diff --git a/src/fsharp/symbols/SymbolHelpers.fs b/src/fsharp/symbols/SymbolHelpers.fs index 82e613a3e56..ec61645da86 100644 --- a/src/fsharp/symbols/SymbolHelpers.fs +++ b/src/fsharp/symbols/SymbolHelpers.fs @@ -178,7 +178,7 @@ type internal CompilationErrorLogger (debugName: string, options: FSharpDiagnost member x.GetDiagnostics() = diagnostics.ToArray() -/// This represents the global state established as each task function runs as part of the build. +/// This represents the thread-local state established as each task function runs as part of the build. /// /// Use to reset error and warning handlers. type CompilationGlobalsScope(errorLogger: ErrorLogger, phase: BuildPhase) = From 56c72b8360803ceeaeaac5c807dd48b07896639d Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 1 Mar 2021 14:44:33 +0000 Subject: [PATCH 07/15] fix build --- src/fsharp/service/IncrementalBuild.fs | 8 -------- 1 file changed, 8 deletions(-) diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 2646943a867..0d11d5ab12e 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -298,14 +298,6 @@ type BoundModel private (tcConfig: TcConfig, | _ -> return None } - member this.TryOptionalExtras() = - eventually { - let! prevState = this.GetState(false) - match prevState with - | FullState(_, prevTcInfoExtras) -> return Some prevTcInfoExtras - | _ -> return None - } - member this.Next(syntaxTree) = eventually { let! prevState = this.GetState(true) From 9d0b755e7a05670ebbe43596c7f38173a637573f Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 1 Mar 2021 16:01:16 +0000 Subject: [PATCH 08/15] fix test --- src/fsharp/service/IncrementalBuild.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 0d11d5ab12e..41714d8fc39 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -1099,10 +1099,10 @@ type IncrementalBuilder(tcGlobals, let! state, result = computeInitialBoundModel state ctok |> Eventually.toCancellable return state, Some(result, DateTime.MinValue) else + let state = computeStampedReferencedAssemblies state cache let! state = (state, [0..targetSlot]) ||> Cancellable.fold (fun state slot -> computeBoundModel state cache ctok slot |> Eventually.toCancellable) - let state = computeStampedReferencedAssemblies state cache let result = state.boundModels.[targetSlot] From ad62442f5f3738d77823b717b0884c18e7cc670c Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 1 Mar 2021 18:28:50 +0000 Subject: [PATCH 09/15] better stack traces for cancellable and eventually --- src/fsharp/absil/illib.fs | 149 +++++++++++--------- src/fsharp/absil/illib.fsi | 77 ++++++----- src/fsharp/service/IncrementalBuild.fs | 184 +++++++++++++------------ 3 files changed, 226 insertions(+), 184 deletions(-) diff --git a/src/fsharp/absil/illib.fs b/src/fsharp/absil/illib.fs index 7aaea788918..753f9762135 100644 --- a/src/fsharp/absil/illib.fs +++ b/src/fsharp/absil/illib.fs @@ -725,21 +725,21 @@ module Cancellable = oper ct /// Bind the result of a cancellable computation - let bind f comp1 = + let inline bind f comp1 = Cancellable (fun ct -> match run ct comp1 with | ValueOrCancelled.Value v1 -> run ct (f v1) | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) /// Map the result of a cancellable computation - let map f oper = + let inline map f oper = Cancellable (fun ct -> match run ct oper with | ValueOrCancelled.Value res -> ValueOrCancelled.Value (f res) | ValueOrCancelled.Cancelled err -> ValueOrCancelled.Cancelled err) /// Return a simple value as the result of a cancellable computation - let ret x = Cancellable (fun _ -> ValueOrCancelled.Value x) + let inline ret x = Cancellable (fun _ -> ValueOrCancelled.Value x) /// Fold a cancellable computation along a sequence of inputs let fold f acc seq = @@ -766,7 +766,7 @@ module Cancellable = | canc -> canc) /// Delay a cancellable computation - let delay (f: unit -> Cancellable<'T>) = Cancellable (fun ct -> let (Cancellable g) = f() in g ct) + let inline delay (f: unit -> Cancellable<'T>) = Cancellable (fun ct -> let (Cancellable g) = f() in g ct) /// Run the computation in a mode where it may not be cancelled. The computation never results in a /// ValueOrCancelled.Cancelled. @@ -793,47 +793,50 @@ module Cancellable = let canceled() = Cancellable (fun ct -> ValueOrCancelled.Cancelled (OperationCanceledException ct)) /// Catch exceptions in a computation - let private catch (Cancellable e) = + let inline catch e = + let (Cancellable f) = e Cancellable (fun ct -> try - match e ct with + match f ct with | ValueOrCancelled.Value r -> ValueOrCancelled.Value (Choice1Of2 r) | ValueOrCancelled.Cancelled e -> ValueOrCancelled.Cancelled e with err -> ValueOrCancelled.Value (Choice2Of2 err)) /// Implement try/finally for a cancellable computation - let tryFinally e compensation = + let inline tryFinally e compensation = catch e |> bind (fun res -> compensation() match res with Choice1Of2 r -> ret r | Choice2Of2 err -> raise err) /// Implement try/with for a cancellable computation - let tryWith e handler = + let inline tryWith e handler = catch e |> bind (fun res -> match res with Choice1Of2 r -> ret r | Choice2Of2 err -> handler err) type CancellableBuilder() = - member x.Bind(e, k) = Cancellable.bind k e + member inline _.BindReturn(e, k) = Cancellable.map k e - member x.Return v = Cancellable.ret v + member inline _.Bind(e, k) = Cancellable.bind k e - member x.ReturnFrom v = v + member inline _.Return v = Cancellable.ret v - member x.Combine(e1, e2) = e1 |> Cancellable.bind (fun () -> e2) + member inline _.ReturnFrom (v: Cancellable<'T>) = v - member x.For(es, f) = es |> Cancellable.each f + member inline _.Combine(e1, e2) = e1 |> Cancellable.bind (fun () -> e2) - member x.TryWith(e, handler) = Cancellable.tryWith e handler + member inline _.For(es, f) = es |> Cancellable.each f - member x.Using(resource, e) = Cancellable.tryFinally (e resource) (fun () -> (resource :> IDisposable).Dispose()) + member inline _.TryWith(e, handler) = Cancellable.tryWith e handler - member x.TryFinally(e, compensation) = Cancellable.tryFinally e compensation + member inline _.Using(resource, e) = Cancellable.tryFinally (e resource) (fun () -> (resource :> IDisposable).Dispose()) - member x.Delay f = Cancellable.delay f + member inline _.TryFinally(e, compensation) = Cancellable.tryFinally e compensation - member x.Zero() = Cancellable.ret () + member inline _.Delay f = Cancellable.delay f + + member inline _.Zero() = Cancellable.ret () [] module CancellableAutoOpens = @@ -854,25 +857,33 @@ module CancellableAutoOpens = type Eventually<'T> = | Done of 'T | NotYetDone of (CancellationToken -> ValueOrCancelled>) + | Delimited of (unit -> IDisposable) * Eventually<'T> module Eventually = - let rec map f e = - match e with - | Done x -> Done (f x) - | NotYetDone work -> - NotYetDone (fun ct -> - match work ct with - | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce - | ValueOrCancelled.Value e2 -> ValueOrCancelled.Value (map f e2)) + let inline map f e = + let rec loop e = + match e with + | Done x -> Done (f x) + | Delimited (resourcef, ev2) -> + Delimited (resourcef, loop ev2) + | NotYetDone work -> + NotYetDone (fun ct -> + match work ct with + | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce + | ValueOrCancelled.Value e2 -> ValueOrCancelled.Value (loop e2)) + loop e let box e = map Operators.box e - let toCancellable e = + let inline toCancellable e = Cancellable (fun ct -> let rec loop e = match e with | Done x -> ValueOrCancelled.Value x + | Delimited (resourcef, ev2) -> + use _resource = resourcef() + loop ev2 | NotYetDone work -> if ct.IsCancellationRequested then ValueOrCancelled.Cancelled (OperationCanceledException ct) @@ -882,7 +893,7 @@ module Eventually = | ValueOrCancelled.Value e2 -> loop e2 loop e) - let ofCancellable (Cancellable f) = + let inline ofCancellable (Cancellable f) = NotYetDone (fun ct -> match f ct with | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce @@ -896,11 +907,13 @@ module Eventually = let force ct e = Cancellable.run ct (toCancellable e) let forceForTimeSlice (sw: Stopwatch) timeShareInMilliseconds (ct: CancellationToken) e = - sw.Reset() - sw.Start() + sw.Restart() let rec loop e = match e with | Done _ -> ValueOrCancelled.Value e + | Delimited (resourcef, ev2) -> + use _resource = resourcef() + loop ev2 | NotYetDone work -> if ct.IsCancellationRequested then sw.Stop() @@ -914,32 +927,42 @@ module Eventually = | ValueOrCancelled.Value e2 -> loop e2 loop e - let rec bind k e = - match e with - | Done x -> k x - | NotYetDone work -> - NotYetDone (fun ct -> - match work ct with - | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce - | ValueOrCancelled.Value e2 -> ValueOrCancelled.Value (bind k e2)) + let inline bind k e = + let rec loop e = + match e with + | Done x -> k x + | Delimited (resourcef, ev2) -> + use _resource = resourcef() + loop ev2 + | NotYetDone work -> + NotYetDone (fun ct -> + match work ct with + | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce + | ValueOrCancelled.Value e2 -> ValueOrCancelled.Value (loop e2)) + loop e - let fold f acc seq = + let inline fold f acc seq = (Done acc, seq) ||> Seq.fold (fun acc x -> acc |> bind (fun acc -> f acc x)) - let rec catch e = - match e with - | Done x -> Done(Result x) - | NotYetDone work -> - NotYetDone (fun ct -> - let res = try Result(work ct) with | e -> Exception e - match res with - | Result (ValueOrCancelled.Value cont) -> ValueOrCancelled.Value (catch cont) - | Result (ValueOrCancelled.Cancelled ce) -> ValueOrCancelled.Cancelled ce - | Exception e -> ValueOrCancelled.Value (Done(Exception e))) + let inline catch e = + let rec loop e = + match e with + | Done x -> Done(Result x) + | Delimited (resourcef, ev2) -> + use _resource = resourcef() + loop ev2 + | NotYetDone work -> + NotYetDone (fun ct -> + let res = try Result(work ct) with | e -> Exception e + match res with + | Result (ValueOrCancelled.Value cont) -> ValueOrCancelled.Value (loop cont) + | Result (ValueOrCancelled.Cancelled ce) -> ValueOrCancelled.Cancelled ce + | Exception e -> ValueOrCancelled.Value (Done(Exception e))) + loop e - let delay f = NotYetDone (fun _ct -> ValueOrCancelled.Value (f ())) + let inline delay f = NotYetDone (fun _ct -> ValueOrCancelled.Value (f ())) - let tryFinally e compensation = + let inline tryFinally e compensation = catch e |> bind (fun res -> compensation() @@ -947,30 +970,32 @@ module Eventually = | Result v -> Eventually.Done v | Exception e -> raise e) - let tryWith e handler = + let inline tryWith e handler = catch e |> bind (function Result v -> Done v | Exception e -> handler e) + let reusing resourcef e = Eventually.Delimited(resourcef, e) + type EventuallyBuilder() = - member x.BindReturn(e, k) = Eventually.map k e + member inline _.BindReturn(e, k) = Eventually.map k e - member x.Bind(e, k) = Eventually.bind k e + member inline _.Bind(e, k) = Eventually.bind k e - member x.Return v = Eventually.Done v + member inline _.Return v = Eventually.Done v - member x.ReturnFrom v = v + member inline _.ReturnFrom v = v - member x.Combine(e1, e2) = e1 |> Eventually.bind (fun () -> e2) + member inline _.Combine(e1, e2) = e1 |> Eventually.bind (fun () -> e2) - member x.TryWith(e, handler) = Eventually.tryWith e handler + member inline _.TryWith(e, handler) = Eventually.tryWith e handler - member x.TryFinally(e, compensation) = Eventually.tryFinally e compensation + member inline _.TryFinally(e, compensation) = Eventually.tryFinally e compensation - member x.Delay f = Eventually.delay f + member inline _.Delay f = Eventually.delay f - member x.Zero() = Eventually.Done () + member inline _.Zero() = Eventually.Done () [] module internal EventuallyAutoOpens = @@ -1030,7 +1055,7 @@ type LazyWithContextFailure(exn: exn) = static let undefined = new LazyWithContextFailure(UndefinedException) - member x.Exception = exn + member _.Exception = exn static member Undefined = undefined diff --git a/src/fsharp/absil/illib.fsi b/src/fsharp/absil/illib.fsi index e0e0286c677..55a6c80e1ac 100644 --- a/src/fsharp/absil/illib.fsi +++ b/src/fsharp/absil/illib.fsi @@ -359,13 +359,13 @@ module internal Cancellable = val run : ct:CancellationToken -> Cancellable<'a> -> ValueOrCancelled<'a> /// Bind the result of a cancellable computation - val bind : f:('a -> Cancellable<'b>) -> comp1:Cancellable<'a> -> Cancellable<'b> + val inline bind : f:('a -> Cancellable<'b>) -> comp1:Cancellable<'a> -> Cancellable<'b> /// Map the result of a cancellable computation - val map: f:('a -> 'b) -> oper:Cancellable<'a> -> Cancellable<'b> + val inline map: f:('a -> 'b) -> oper:Cancellable<'a> -> Cancellable<'b> /// Return a simple value as the result of a cancellable computation - val ret: x:'a -> Cancellable<'a> + val inline ret: x:'a -> Cancellable<'a> /// Fold a cancellable computation along a sequence of inputs val fold : f:('a -> 'b -> Cancellable<'a>) -> acc:'a -> seq:seq<'b> -> Cancellable<'a> @@ -374,7 +374,7 @@ module internal Cancellable = val each : f:('a -> Cancellable<'b>) -> seq:seq<'a> -> Cancellable<'b list> /// Delay a cancellable computation - val delay: f:(unit -> Cancellable<'T>) -> Cancellable<'T> + val inline delay: f:(unit -> Cancellable<'T>) -> Cancellable<'T> /// Run the computation in a mode where it may not be cancelled. The computation never results in a /// ValueOrCancelled.Cancelled. @@ -387,10 +387,13 @@ module internal Cancellable = val canceled: unit -> Cancellable<'a> /// Implement try/finally for a cancellable computation - val tryFinally : e:Cancellable<'a> -> compensation:(unit -> unit) -> Cancellable<'a> + val inline catch : e:Cancellable<'a> -> Cancellable> + + /// Implement try/finally for a cancellable computation + val inline tryFinally : e:Cancellable<'a> -> compensation:(unit -> unit) -> Cancellable<'a> /// Implement try/with for a cancellable computation - val tryWith : e:Cancellable<'a> -> handler:(exn -> Cancellable<'a>) -> Cancellable<'a> + val inline tryWith : e:Cancellable<'a> -> handler:(exn -> Cancellable<'a>) -> Cancellable<'a> val toAsync: Cancellable<'a> -> Async<'a> @@ -398,25 +401,27 @@ type internal CancellableBuilder = new: unit -> CancellableBuilder - member Bind: e:Cancellable<'k> * k:('k -> Cancellable<'l>) -> Cancellable<'l> + member inline BindReturn: e:Cancellable<'T> * k:('T -> 'U) -> Cancellable<'U> + + member inline Bind: e:Cancellable<'T> * k:('T -> Cancellable<'U>) -> Cancellable<'U> - member Combine: e1:Cancellable * e2:Cancellable<'h> -> Cancellable<'h> + member inline Combine: e1:Cancellable * e2:Cancellable<'T> -> Cancellable<'T> - member Delay: f:(unit -> Cancellable<'a>) -> Cancellable<'a> + member inline Delay: f:(unit -> Cancellable<'T>) -> Cancellable<'T> - member For: es:seq<'f> * f:('f -> Cancellable<'g>) -> Cancellable<'g list> + member inline For: es:seq<'T> * f:('T -> Cancellable<'U>) -> Cancellable<'U list> - member Return: v:'j -> Cancellable<'j> + member inline Return: v:'T -> Cancellable<'T> - member ReturnFrom: v:'i -> 'i + member inline ReturnFrom: v:Cancellable<'T> -> Cancellable<'T> - member TryFinally: e:Cancellable<'b> * compensation:(unit -> unit) -> Cancellable<'b> + member inline TryFinally: e:Cancellable<'T> * compensation:(unit -> unit) -> Cancellable<'T> - member TryWith: e:Cancellable<'e> * handler:(exn -> Cancellable<'e>) -> Cancellable<'e> + member inline TryWith: e:Cancellable<'T> * handler:(exn -> Cancellable<'T>) -> Cancellable<'T> - member Using: resource:'c * e:('c -> Cancellable<'d>) -> Cancellable<'d> when 'c :> System.IDisposable + member inline Using: resource:'c * e:('c -> Cancellable<'T>) -> Cancellable<'T> when 'c :> System.IDisposable - member Zero: unit -> Cancellable + member inline Zero: unit -> Cancellable [] module internal CancellableAutoOpens = @@ -435,15 +440,16 @@ module internal CancellableAutoOpens = type internal Eventually<'T> = | Done of 'T | NotYetDone of (CancellationToken -> ValueOrCancelled>) + | Delimited of (unit -> IDisposable) * Eventually<'T> module internal Eventually = val box: e:Eventually<'a> -> Eventually // Throws away time-slicing but retains cancellation - val toCancellable: e:Eventually<'a> -> Cancellable<'a> + val inline toCancellable: e:Eventually<'T> -> Cancellable<'T> - val ofCancellable: Cancellable<'T> -> Eventually<'T> + val inline ofCancellable: Cancellable<'T> -> Eventually<'T> val force: ct: CancellationToken -> e:Eventually<'a> -> ValueOrCancelled<'a> @@ -452,17 +458,19 @@ module internal Eventually = /// was detected. val forceForTimeSlice: sw:Stopwatch -> timeShareInMilliseconds: int64 -> ct: CancellationToken -> e: Eventually<'a> -> ValueOrCancelled> - val bind: k:('a -> Eventually<'b>) -> e:Eventually<'a> -> Eventually<'b> + val inline map: f:('a -> 'b) -> e:Eventually<'a> -> Eventually<'b> - val fold : f:('a -> 'b -> Eventually<'a>) -> acc:'a -> seq:seq<'b> -> Eventually<'a> + val inline bind: k:('a -> Eventually<'b>) -> e:Eventually<'a> -> Eventually<'b> - val catch: e:Eventually<'a> -> Eventually> + val inline fold : f:('a -> 'b -> Eventually<'a>) -> acc:'a -> seq:seq<'b> -> Eventually<'a> - val delay: f:(unit -> Eventually<'T>) -> Eventually<'T> + val inline catch: e:Eventually<'a> -> Eventually> - val tryFinally : e:Eventually<'a> -> compensation:(unit -> unit) -> Eventually<'a> + val inline delay: f:(unit -> Eventually<'T>) -> Eventually<'T> - val tryWith : e:Eventually<'a> -> handler:(System.Exception -> Eventually<'a>) -> Eventually<'a> + val inline tryFinally : e:Eventually<'a> -> compensation:(unit -> unit) -> Eventually<'a> + + val inline tryWith : e:Eventually<'a> -> handler:(System.Exception -> Eventually<'a>) -> Eventually<'a> /// Bind the cancellation token associated with the computation val token: unit -> Eventually @@ -470,26 +478,29 @@ module internal Eventually = /// Represents a canceled computation val canceled: unit -> Eventually<'a> + /// Create the resource and install it on the stack each time the Eventually is restarted + val reusing: resourcef: (unit -> IDisposable) -> e:Eventually<'T> -> Eventually<'T> + [] type internal EventuallyBuilder = - member BindReturn: e:Eventually<'g> * k:('g -> 'h) -> Eventually<'h> + member inline BindReturn: e:Eventually<'g> * k:('g -> 'h) -> Eventually<'h> - member Bind: e:Eventually<'g> * k:('g -> Eventually<'h>) -> Eventually<'h> + member inline Bind: e:Eventually<'g> * k:('g -> Eventually<'h>) -> Eventually<'h> - member Combine: e1:Eventually * e2:Eventually<'d> -> Eventually<'d> + member inline Combine: e1:Eventually * e2:Eventually<'d> -> Eventually<'d> - member Delay: f:(unit -> Eventually<'a>) -> Eventually<'a> + member inline Delay: f:(unit -> Eventually<'a>) -> Eventually<'a> - member Return: v:'f -> Eventually<'f> + member inline Return: v:'f -> Eventually<'f> - member ReturnFrom: v:'e -> 'e + member inline ReturnFrom: v:'e -> 'e - member TryFinally: e:Eventually<'b> * compensation:(unit -> unit) -> Eventually<'b> + member inline TryFinally: e:Eventually<'b> * compensation:(unit -> unit) -> Eventually<'b> - member TryWith: e:Eventually<'c> * handler:(System.Exception -> Eventually<'c>) -> Eventually<'c> + member inline TryWith: e:Eventually<'c> * handler:(System.Exception -> Eventually<'c>) -> Eventually<'c> - member Zero: unit -> Eventually + member inline Zero: unit -> Eventually [] module internal EventuallyAutoOpens = diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 41714d8fc39..0c4b739360b 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -397,100 +397,106 @@ type BoundModel private (tcConfig: TcConfig, None match syntaxTree.Parse sigNameOpt with | input, _sourceRange, filename, parseErrors -> + IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBETypechecked filename) let capturingErrorLogger = CompilationErrorLogger("TypeCheck", tcConfig.errorSeverityOptions) let errorLogger = GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput input, capturingErrorLogger) - beforeFileChecked.Trigger filename - let prevModuleNamesDict = prevTcInfo.moduleNamesDict - let prevTcState = prevTcInfo.tcState - let prevTcErrorsRev = prevTcInfo.tcErrorsRev - let prevTcDependencyFiles = prevTcInfo.tcDependencyFiles - - ApplyMetaCommandsFromInputToTcConfig (tcConfig, input, Path.GetDirectoryName filename, tcImports.DependencyProvider) |> ignore - let sink = TcResultsSinkImpl(tcGlobals) - let hadParseErrors = not (Array.isEmpty parseErrors) - let input, moduleNamesDict = DeduplicateParsedInputModuleName prevModuleNamesDict input - - Logger.LogBlockMessageStart filename LogCompilerFunctionId.IncrementalBuild_TypeCheck - let! (tcEnvAtEndOfFile, topAttribs, implFile, ccuSigForFile), tcState = - TypeCheckOneInputEventually - ((fun () -> hadParseErrors || errorLogger.ErrorCount > 0), - tcConfig, tcImports, - tcGlobals, - None, - (if partialCheck then TcResultsSink.NoSink else TcResultsSink.WithSink sink), - prevTcState, input, - partialCheck) - Logger.LogBlockMessageStop filename LogCompilerFunctionId.IncrementalBuild_TypeCheck - - fileChecked.Trigger filename - let newErrors = Array.append parseErrors (capturingErrorLogger.GetDiagnostics()) - - let tcEnvAtEndOfFile = if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls - - let tcInfo = - { - tcState = tcState - tcEnvAtEndOfFile = tcEnvAtEndOfFile - moduleNamesDict = moduleNamesDict - latestCcuSigForFile = Some ccuSigForFile - tcErrorsRev = newErrors :: prevTcErrorsRev - topAttribs = Some topAttribs - tcDependencyFiles = filename :: prevTcDependencyFiles - sigNameOpt = - match input with - | ParsedInput.SigFile(ParsedSigFileInput(fileName=fileName;qualifiedNameOfFile=qualName)) -> - Some(fileName, qualName) - | _ -> - None - } - - if partialCheck then - return PartialState tcInfo - else - match! prevTcInfoExtras() with - | None -> return PartialState tcInfo - | Some prevTcInfoOptional -> - // Build symbol keys - let itemKeyStore, semanticClassification = - if enableBackgroundItemKeyStoreAndSemanticClassification then - Logger.LogBlockMessageStart filename LogCompilerFunctionId.IncrementalBuild_CreateItemKeyStoreAndSemanticClassification - let sResolutions = sink.GetResolutions() - let builder = ItemKeyStoreBuilder() - let preventDuplicates = HashSet({ new IEqualityComparer with - member _.Equals((s1, e1): struct(pos * pos), (s2, e2): struct(pos * pos)) = Position.posEq s1 s2 && Position.posEq e1 e2 - member _.GetHashCode o = o.GetHashCode() }) - sResolutions.CapturedNameResolutions - |> Seq.iter (fun cnr -> - let r = cnr.Range - if preventDuplicates.Add struct(r.Start, r.End) then - builder.Write(cnr.Range, cnr.Item)) + // This reinstalls the CompilationGlobalsScope each time the Eventually is restarted, potentially + // on a new thread. This is needed because CompilationGlobalsScope installs thread local variables. + return! Eventually.reusing (fun () -> new CompilationGlobalsScope (errorLogger, BuildPhase.TypeCheck) :> IDisposable) <| eventually { + + beforeFileChecked.Trigger filename + let prevModuleNamesDict = prevTcInfo.moduleNamesDict + let prevTcState = prevTcInfo.tcState + let prevTcErrorsRev = prevTcInfo.tcErrorsRev + let prevTcDependencyFiles = prevTcInfo.tcDependencyFiles + + ApplyMetaCommandsFromInputToTcConfig (tcConfig, input, Path.GetDirectoryName filename, tcImports.DependencyProvider) |> ignore + let sink = TcResultsSinkImpl(tcGlobals) + let hadParseErrors = not (Array.isEmpty parseErrors) + let input, moduleNamesDict = DeduplicateParsedInputModuleName prevModuleNamesDict input + + Logger.LogBlockMessageStart filename LogCompilerFunctionId.IncrementalBuild_TypeCheck + let! (tcEnvAtEndOfFile, topAttribs, implFile, ccuSigForFile), tcState = + TypeCheckOneInputEventually + ((fun () -> hadParseErrors || errorLogger.ErrorCount > 0), + tcConfig, tcImports, + tcGlobals, + None, + (if partialCheck then TcResultsSink.NoSink else TcResultsSink.WithSink sink), + prevTcState, input, + partialCheck) + Logger.LogBlockMessageStop filename LogCompilerFunctionId.IncrementalBuild_TypeCheck + + fileChecked.Trigger filename + let newErrors = Array.append parseErrors (capturingErrorLogger.GetDiagnostics()) + + let tcEnvAtEndOfFile = if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls + + let tcInfo = + { + tcState = tcState + tcEnvAtEndOfFile = tcEnvAtEndOfFile + moduleNamesDict = moduleNamesDict + latestCcuSigForFile = Some ccuSigForFile + tcErrorsRev = newErrors :: prevTcErrorsRev + topAttribs = Some topAttribs + tcDependencyFiles = filename :: prevTcDependencyFiles + sigNameOpt = + match input with + | ParsedInput.SigFile(ParsedSigFileInput(fileName=fileName;qualifiedNameOfFile=qualName)) -> + Some(fileName, qualName) + | _ -> + None + } + + if partialCheck then + return PartialState tcInfo + else + match! prevTcInfoExtras() with + | None -> return PartialState tcInfo + | Some prevTcInfoOptional -> + // Build symbol keys + let itemKeyStore, semanticClassification = + if enableBackgroundItemKeyStoreAndSemanticClassification then + Logger.LogBlockMessageStart filename LogCompilerFunctionId.IncrementalBuild_CreateItemKeyStoreAndSemanticClassification + let sResolutions = sink.GetResolutions() + let builder = ItemKeyStoreBuilder() + let preventDuplicates = HashSet({ new IEqualityComparer with + member _.Equals((s1, e1): struct(pos * pos), (s2, e2): struct(pos * pos)) = Position.posEq s1 s2 && Position.posEq e1 e2 + member _.GetHashCode o = o.GetHashCode() }) + sResolutions.CapturedNameResolutions + |> Seq.iter (fun cnr -> + let r = cnr.Range + if preventDuplicates.Add struct(r.Start, r.End) then + builder.Write(cnr.Range, cnr.Item)) - let semanticClassification = sResolutions.GetSemanticClassification(tcGlobals, tcImports.GetImportMap(), sink.GetFormatSpecifierLocations(), None) - - let sckBuilder = SemanticClassificationKeyStoreBuilder() - sckBuilder.WriteAll semanticClassification - - let res = builder.TryBuildAndReset(), sckBuilder.TryBuildAndReset() - Logger.LogBlockMessageStop filename LogCompilerFunctionId.IncrementalBuild_CreateItemKeyStoreAndSemanticClassification - res - else - None, None - - let tcInfoExtras = - { - /// Only keep the typed interface files when doing a "full" build for fsc.exe, otherwise just throw them away - latestImplFile = if keepAssemblyContents then implFile else None - tcResolutionsRev = (if keepAllBackgroundResolutions then sink.GetResolutions() else TcResolutions.Empty) :: prevTcInfoOptional.tcResolutionsRev - tcSymbolUsesRev = (if keepAllBackgroundSymbolUses then sink.GetSymbolUses() else TcSymbolUses.Empty) :: prevTcInfoOptional.tcSymbolUsesRev - tcOpenDeclarationsRev = sink.GetOpenDeclarations() :: prevTcInfoOptional.tcOpenDeclarationsRev - itemKeyStore = itemKeyStore - semanticClassificationKeyStore = semanticClassification - } - - return FullState(tcInfo, tcInfoExtras) - } + let semanticClassification = sResolutions.GetSemanticClassification(tcGlobals, tcImports.GetImportMap(), sink.GetFormatSpecifierLocations(), None) + + let sckBuilder = SemanticClassificationKeyStoreBuilder() + sckBuilder.WriteAll semanticClassification + + let res = builder.TryBuildAndReset(), sckBuilder.TryBuildAndReset() + Logger.LogBlockMessageStop filename LogCompilerFunctionId.IncrementalBuild_CreateItemKeyStoreAndSemanticClassification + res + else + None, None + + let tcInfoExtras = + { + /// Only keep the typed interface files when doing a "full" build for fsc.exe, otherwise just throw them away + latestImplFile = if keepAssemblyContents then implFile else None + tcResolutionsRev = (if keepAllBackgroundResolutions then sink.GetResolutions() else TcResolutions.Empty) :: prevTcInfoOptional.tcResolutionsRev + tcSymbolUsesRev = (if keepAllBackgroundSymbolUses then sink.GetSymbolUses() else TcSymbolUses.Empty) :: prevTcInfoOptional.tcSymbolUsesRev + tcOpenDeclarationsRev = sink.GetOpenDeclarations() :: prevTcInfoOptional.tcOpenDeclarationsRev + itemKeyStore = itemKeyStore + semanticClassificationKeyStore = semanticClassification + } + + return FullState(tcInfo, tcInfoExtras) + } + } static member Create(tcConfig: TcConfig, tcGlobals: TcGlobals, From 53ef80ad34e3ca338ff77124274ed437511ee499 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 1 Mar 2021 18:55:09 +0000 Subject: [PATCH 10/15] docs --- docs/fcs/queue.fsx | 44 ++++++++++++++++++++++++++++++++------------ 1 file changed, 32 insertions(+), 12 deletions(-) diff --git a/docs/fcs/queue.fsx b/docs/fcs/queue.fsx index 88a5af258ec..a9bbb1df02b 100644 --- a/docs/fcs/queue.fsx +++ b/docs/fcs/queue.fsx @@ -9,26 +9,34 @@ This is a design note on the FSharpChecker component and its operations queue. FSharpChecker maintains an operations queue. Items from the FSharpChecker operations queue are processed sequentially and in order. -The thread processing these requests can also run a low-priority, interleaved background operation when the -queue is empty. This can be used to implicitly bring the background check of a project "up-to-date". +This means the FCS API has three kinds of operations: + +* "Runs on caller thread (runs on caller thread)" - Some requests from FSharp.Editor are serviced concurrently without using the queue at all. Everything without +in Async return type are in this category. + +* "Queued-at-high-priority (runs on reactor thread)" - These are requests made via the FCS API (e.g. from FSharp.Editor) and anything with "Async" in the return type is in this category. The originating calls are not typically on the UI thread and are associated with active actions by the user (editing a file etc.). + +* "Queued and interleaved at lower priority (runs on reactor thread)" - This is reserved for a "background" job (CheckProjectInBackground) used for to prepare the project builder state of the current project being worked on. The "background" work is intended to be divided into little chunks so it can always be interrupted in order to service the higher-priority work. + +The "Queued-at-lower-priority" operation runs as a low-priority, interleaved operation when the +queue is empty. This is used to implicitly bring the background check of a project "up-to-date". When the operations queue has been empty for 1 second, -this background work is run in small incremental fragments. This work is cooperatively time-sliced to be approximately <50ms, (see `maxTimeShareMilliseconds` in +this work is run in small incremental fragments. The overall work may get cancelled if replaced +by an alternative project build. This work is cooperatively +time-sliced to be approximately <50ms, (see `maxTimeShareMilliseconds` in IncrementalBuild.fs). The project to be checked in the background is set implicitly by calls to ``CheckFileInProject`` and ``ParseAndCheckFileInProject``. To disable implicit background checking completely, set ``checker.ImplicitlyStartBackgroundWork`` to false. To change the time before background work starts, set ``checker.PauseBeforeBackgroundWork`` to the required number of milliseconds. -Most calls to the FSharpChecker API enqueue an operation in the FSharpChecker compiler queue. These correspond to the -calls to EnqueueAndAwaitOpAsync in [service.fs](https://github.com/fsharp/FSharp.Compiler.Service/blob/master/src/fsharp/service/service.fs). +Several calls to the FSharpChecker API enqueue an operation in the FSharpChecker compiler queue (the "Queued-at-high-priority" category). +These correspond to the calls to EnqueueAndAwaitOpAsync in [service.fs](https://github.com/fsharp/FSharp.Compiler.Service/blob/master/src/fsharp/service/service.fs). * For example, calling `ParseAndCheckProject` enqueues a `ParseAndCheckProjectImpl` operation. The time taken for the operation will depend on how much work is required to bring the project analysis up-to-date. -* Likewise, calling any of `GetUsesOfSymbol`, `GetAllUsesOfAllSymbols`, `ParseFileInProject`, - `GetBackgroundParseResultsForFileInProject`, `MatchBraces`, `CheckFileInProjectIfReady`, `ParseAndCheckFileInProject`, `GetBackgroundCheckResultsForFileInProject`, - `ParseAndCheckProject`, `GetProjectOptionsFromScript`, `InvalidateConfiguration`, `InvaidateAll` and operations - on FSharpCheckResults will cause an operation to be enqueued. The length of the operation will - vary - many will be very fast - but they won't be processed until other operations already in the queue are complete. +The length of the operation will vary - many will be very fast - but they won't +be processed until other operations already in the queue are complete. Some operations do not enqueue anything on the FSharpChecker operations queue - notably any accesses to the Symbol APIs. These use cross-threaded access to the TAST data produced by other FSharpChecker operations. @@ -39,18 +47,30 @@ of FSharp.Compiler.Service.dll to see the Trace.WriteInformation messages indica operations queue and the time to process requests. For those writing interactive editors which use FCS, you -should be cautious about operations that request a check of the entire project. +should be cautious about operations that request a check of the entire project - these +operations will be "Queued-as-high-priority" and run in preference to other similar operations +and must be both asynchronous and cancelled if the results will no longer be needed. For example, be careful about requesting the check of an entire project on operations like "Highlight Symbol" or "Find Unused Declarations" (which run automatically when the user opens a file or moves the cursor). as opposed to operations like "Find All References" (which a user explicitly triggers). -Project checking can cause long and contention on the FSharpChecker operations queue. +Project checking can cause long and contention on the FSharpChecker operations queue. You *must* +cancel such operations if the results will be out-of-date, in order for your editing tools to be performant. Requests to FCS can be cancelled by cancelling the async operation. (Some requests also include additional callbacks which can be used to indicate a cancellation condition). This cancellation will be effective if the cancellation is performed before the operation is executed in the operations queue. +The long term intent of FCS is to eventually remove the queue altogether. However the queue +has several operational impacts we need to be mindful of + +1. It acts as a brake on the overall resource usage (if 1000 requests get made from FSharp.Editor they are serviced one at a time, and the work is not generally repeated as it get cached). + +2. It acts as a data-lock on the project builder compilation state, not all of which is thread safe (though we keep reviewing it). + +3. It runs the low-priority project build + Summary ------- From 8f1c17df0f0e1b9e7cbb2325f4ca01e058205810 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 1 Mar 2021 19:00:30 +0000 Subject: [PATCH 11/15] docs --- docs/fcs/queue.fsx | 73 +++++++++++++++++++++++----------------------- 1 file changed, 36 insertions(+), 37 deletions(-) diff --git a/docs/fcs/queue.fsx b/docs/fcs/queue.fsx index a9bbb1df02b..bc9e8595b5d 100644 --- a/docs/fcs/queue.fsx +++ b/docs/fcs/queue.fsx @@ -11,45 +11,45 @@ sequentially and in order. This means the FCS API has three kinds of operations: -* "Runs on caller thread (runs on caller thread)" - Some requests from FSharp.Editor are serviced concurrently without using the queue at all. Everything without -in Async return type are in this category. +* "Runs on caller thread (runs on caller thread)" - Some requests from FSharp.Editor are + serviced concurrently without using the queue at all. Everything without an Async return type + is in this category. -* "Queued-at-high-priority (runs on reactor thread)" - These are requests made via the FCS API (e.g. from FSharp.Editor) and anything with "Async" in the return type is in this category. The originating calls are not typically on the UI thread and are associated with active actions by the user (editing a file etc.). +* "Queued-at-high-priority (runs on reactor thread)" - These are requests made via the FCS API + (e.g. from FSharp.Editor) and anything with "Async" return type is in this category. The + originating calls are not typically on the UI thread and are associated with active actions + by the user (editing a file etc.). -* "Queued and interleaved at lower priority (runs on reactor thread)" - This is reserved for a "background" job (CheckProjectInBackground) used for to prepare the project builder state of the current project being worked on. The "background" work is intended to be divided into little chunks so it can always be interrupted in order to service the higher-priority work. - -The "Queued-at-lower-priority" operation runs as a low-priority, interleaved operation when the -queue is empty. This is used to implicitly bring the background check of a project "up-to-date". -When the operations queue has been empty for 1 second, -this work is run in small incremental fragments. The overall work may get cancelled if replaced -by an alternative project build. This work is cooperatively -time-sliced to be approximately <50ms, (see `maxTimeShareMilliseconds` in -IncrementalBuild.fs). The project to be checked in the background is set implicitly -by calls to ``CheckFileInProject`` and ``ParseAndCheckFileInProject``. -To disable implicit background checking completely, set ``checker.ImplicitlyStartBackgroundWork`` to false. -To change the time before background work starts, set ``checker.PauseBeforeBackgroundWork`` to the required number of milliseconds. - -Several calls to the FSharpChecker API enqueue an operation in the FSharpChecker compiler queue (the "Queued-at-high-priority" category). -These correspond to the calls to EnqueueAndAwaitOpAsync in [service.fs](https://github.com/fsharp/FSharp.Compiler.Service/blob/master/src/fsharp/service/service.fs). - -* For example, calling `ParseAndCheckProject` enqueues a `ParseAndCheckProjectImpl` operation. The time taken for the + These correspond to the calls to EnqueueAndAwaitOpAsync in [service.fs](https://github.com/fsharp/FSharp.Compiler.Service/blob/master/src/fsharp/service/service.fs). + For example, calling `ParseAndCheckProject` enqueues a `ParseAndCheckProjectImpl` operation. The time taken for the operation will depend on how much work is required to bring the project analysis up-to-date. - -The length of the operation will vary - many will be very fast - but they won't -be processed until other operations already in the queue are complete. - -Some operations do not enqueue anything on the FSharpChecker operations queue - notably any accesses to the Symbol APIs. -These use cross-threaded access to the TAST data produced by other FSharpChecker operations. - -Some tools throw a lot of interactive work at the FSharpChecker operations queue. + The length of the operation will vary - many will be very fast - but they won't + be processed until other operations already in the queue are complete. + +* "Queued and interleaved at lower priority (runs on reactor thread)" - This is reserved + for a "background" job (CheckProjectInBackground) used for to prepare the project builder + state of the current project being worked on. The "background" work is intended to be + divided into little chunks so it can always be interrupted in order to service the higher-priority work. + + This operation runs when the queue is empty. When the operations queue has been empty for 1 second, + this work is run in small incremental fragments. The overall work may get cancelled if replaced + by an alternative project build. This work is cooperatively + time-sliced to be approximately <50ms, (see `maxTimeShareMilliseconds` in + IncrementalBuild.fs). The project to be checked in the background is set implicitly + by calls to ``CheckFileInProject`` and ``ParseAndCheckFileInProject``. + To disable implicit background checking completely, set ``checker.ImplicitlyStartBackgroundWork`` to false. + To change the time before background work starts, set ``checker.PauseBeforeBackgroundWork`` to the required + number of milliseconds. + +Some tools throw a lot of "Queued-at-high-priority" work at the FSharpChecker operations queue. If you are writing such a component, consider running your project against a debug build of FSharp.Compiler.Service.dll to see the Trace.WriteInformation messages indicating the length of the operations queue and the time to process requests. For those writing interactive editors which use FCS, you -should be cautious about operations that request a check of the entire project - these -operations will be "Queued-as-high-priority" and run in preference to other similar operations -and must be both asynchronous and cancelled if the results will no longer be needed. +should be cautious about long running "Queued-at-high-priority" operations - these +will run in preference to other similar operations and must be both asynchronous +and cancelled if the results will no longer be needed. For example, be careful about requesting the check of an entire project on operations like "Highlight Symbol" or "Find Unused Declarations" (which run automatically when the user opens a file or moves the cursor). @@ -57,19 +57,18 @@ as opposed to operations like "Find All References" (which a user explicitly tri Project checking can cause long and contention on the FSharpChecker operations queue. You *must* cancel such operations if the results will be out-of-date, in order for your editing tools to be performant. -Requests to FCS can be cancelled by cancelling the async operation. (Some requests also +Requests can be cancelled via the cancellation token of the async operation. (Some requests also include additional callbacks which can be used to indicate a cancellation condition). -This cancellation will be effective if the cancellation is performed before the operation -is executed in the operations queue. +If the operation has not yet started it will remain in the queue and be discarded when it reaches the front. -The long term intent of FCS is to eventually remove the queue altogether. However the queue +The long term intent of FCS is to eventually remove the reactor thread and the operations queue. However the queue has several operational impacts we need to be mindful of 1. It acts as a brake on the overall resource usage (if 1000 requests get made from FSharp.Editor they are serviced one at a time, and the work is not generally repeated as it get cached). -2. It acts as a data-lock on the project builder compilation state, not all of which is thread safe (though we keep reviewing it). +2. It potentially acts as a data-lock on the project builder compilation state. -3. It runs the low-priority project build +3. It runs the low-priority project build. Summary ------- From 9a1ad893681b140f7093fac1a7f33c28e96db0f3 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 2 Mar 2021 23:52:21 +0000 Subject: [PATCH 12/15] fix bugs with delimited eventually --- src/fsharp/SyntaxTree.fsi | 2 + src/fsharp/absil/illib.fs | 157 +++++++++--------- src/fsharp/absil/illib.fsi | 44 +++-- src/fsharp/pars.fsy | 1 + src/fsharp/service/IncrementalBuild.fs | 93 +++++------ src/fsharp/service/Reactor.fs | 4 +- src/fsharp/service/service.fs | 45 +++-- src/fsharp/service/service.fsi | 39 ++++- .../SurfaceArea.netstandard.fs | 14 +- tests/service/PerfTests.fs | 10 +- tests/service/ProjectAnalysisTests.fs | 39 ++--- .../FSharp.LanguageService/FSharpSource.fs | 1 + .../UnitTests/TestLib.LanguageService.fs | 2 +- 13 files changed, 249 insertions(+), 202 deletions(-) diff --git a/src/fsharp/SyntaxTree.fsi b/src/fsharp/SyntaxTree.fsi index efe5bcf47c6..f2c0f6e0893 100644 --- a/src/fsharp/SyntaxTree.fsi +++ b/src/fsharp/SyntaxTree.fsi @@ -11,10 +11,12 @@ type Ident = new: text: string * range: range -> Ident member idText: string member idRange: range + /// Represents a long identifier e.g. 'A.B.C' type LongIdent = Ident list + /// Represents a long identifier with possible '.' at end. /// /// Typically dotRanges.Length = lid.Length-1, but they may be same if (incomplete) code ends in a dot, e.g. "Foo.Bar." diff --git a/src/fsharp/absil/illib.fs b/src/fsharp/absil/illib.fs index 753f9762135..8f8e9036f80 100644 --- a/src/fsharp/absil/illib.fs +++ b/src/fsharp/absil/illib.fs @@ -751,19 +751,8 @@ module Cancellable = | res -> res)) /// Iterate a cancellable computation over a collection - let each f seq = - Cancellable (fun ct -> - (ValueOrCancelled.Value [], seq) - ||> Seq.fold (fun acc x -> - match acc with - | ValueOrCancelled.Value acc -> - match run ct (f x) with - | ValueOrCancelled.Value x2 -> ValueOrCancelled.Value (x2 :: acc) - | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1 - | canc -> canc) - |> function - | ValueOrCancelled.Value acc -> ValueOrCancelled.Value (List.rev acc) - | canc -> canc) + let inline each f seq = + fold (fun acc x -> f x |> map (fun y -> (y :: acc))) [] seq |> map List.rev /// Delay a cancellable computation let inline delay (f: unit -> Cancellable<'T>) = Cancellable (fun ct -> let (Cancellable g) = f() in g ct) @@ -842,40 +831,24 @@ type CancellableBuilder() = module CancellableAutoOpens = let cancellable = CancellableBuilder() -/// Computations that can cooperatively yield by returning a continuation -/// -/// - Any yield of a NotYetDone should typically be "abandonable" without adverse consequences. No resource release -/// will be called when the computation is abandoned. +/// Computations that can cooperatively yield /// -/// - Computations suspend via a NotYetDone may use local state (mutables), where these are -/// captured by the NotYetDone closure. Computations do not need to be restartable. -/// -/// - The key thing is that you can take an Eventually value and run it with -/// Eventually.repeatedlyProgressUntilDoneOrTimeShareOverOrCanceled -/// -/// - Cancellation results in a suspended computation rather than complete abandonment +/// - You can take an Eventually value and run it with Eventually.forceForTimeSlice type Eventually<'T> = | Done of 'T - | NotYetDone of (CancellationToken -> ValueOrCancelled>) + | NotYetDone of (CancellationToken -> (Stopwatch * int64) option -> ValueOrCancelled>) + // Indicates an IDisposable should be created and disposed on each step(s) | Delimited of (unit -> IDisposable) * Eventually<'T> module Eventually = - let inline map f e = - let rec loop e = - match e with - | Done x -> Done (f x) - | Delimited (resourcef, ev2) -> - Delimited (resourcef, loop ev2) - | NotYetDone work -> - NotYetDone (fun ct -> - match work ct with - | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce - | ValueOrCancelled.Value e2 -> ValueOrCancelled.Value (loop e2)) - loop e - - let box e = map Operators.box e + let inline ret x = Done x + // Convert to a Cancellable which, when run, takes all steps in the computation, + // installing Delimited resource handlers if needed. + // + // Inlined for better stack traces, because inlining erases library ranges and replaces them + // with ranges in user code. let inline toCancellable e = Cancellable (fun ct -> let rec loop e = @@ -888,79 +861,107 @@ module Eventually = if ct.IsCancellationRequested then ValueOrCancelled.Cancelled (OperationCanceledException ct) else - match work ct with + match work ct None with | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce | ValueOrCancelled.Value e2 -> loop e2 loop e) + // Inlined for better stack traces, because inlining replaces ranges of the "runtime" code in the lambda + // with ranges in user code. let inline ofCancellable (Cancellable f) = - NotYetDone (fun ct -> + NotYetDone (fun ct _ -> match f ct with | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce | ValueOrCancelled.Value v -> ValueOrCancelled.Value (Done v) ) - let token () = NotYetDone (fun ct -> ValueOrCancelled.Value (Done ct)) + let token () = NotYetDone (fun ct _ -> ValueOrCancelled.Value (Done ct)) - let canceled () = NotYetDone (fun ct -> ValueOrCancelled.Cancelled (OperationCanceledException ct)) + let canceled () = NotYetDone (fun ct _ -> ValueOrCancelled.Cancelled (OperationCanceledException ct)) + // Take all steps in the computation, installing Delimited resource handlers if needed let force ct e = Cancellable.run ct (toCancellable e) - let forceForTimeSlice (sw: Stopwatch) timeShareInMilliseconds (ct: CancellationToken) e = - sw.Restart() - let rec loop e = + let stepCheck (ct: CancellationToken) (swinfo: (Stopwatch * int64) option) e = + if ct.IsCancellationRequested then + match swinfo with Some (sw, _) -> sw.Stop() | _ -> () + ValueSome (ValueOrCancelled.Cancelled (OperationCanceledException(ct))) + else + match swinfo with + | Some (sw, timeShareInMilliseconds) when sw.ElapsedMilliseconds > timeShareInMilliseconds -> + sw.Stop() + ValueSome (ValueOrCancelled.Value e) + | _ -> + ValueNone + + // Take multiple steps in the computation, installing Delimited resource handlers if needed, + // until the stopwatch times out if present. + [] + let rec steps (ct: CancellationToken) (swinfo: (Stopwatch * int64) option) e = + match stepCheck ct swinfo e with + | ValueSome res -> res + | ValueNone -> match e with - | Done _ -> ValueOrCancelled.Value e - | Delimited (resourcef, ev2) -> + | Done _ -> ValueOrCancelled.Value e + | Delimited (resourcef, inner) -> use _resource = resourcef() - loop ev2 + match steps ct swinfo inner with + | ValueOrCancelled.Value (Done _ as res) -> ValueOrCancelled.Value res + | ValueOrCancelled.Value inner2 -> ValueOrCancelled.Value (Delimited (resourcef, inner2)) // maintain the Delimited until Done + | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce | NotYetDone work -> - if ct.IsCancellationRequested then - sw.Stop() - ValueOrCancelled.Cancelled (OperationCanceledException(ct)) - elif sw.ElapsedMilliseconds > timeShareInMilliseconds then - sw.Stop() - ValueOrCancelled.Value e - else - match work ct with - | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce - | ValueOrCancelled.Value e2 -> loop e2 - loop e + match work ct swinfo with + | ValueOrCancelled.Value e2 -> steps ct swinfo e2 + | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce + // Take multiple steps in the computation, installing Delimited resource handlers if needed + let forceForTimeSlice (sw: Stopwatch) timeShareInMilliseconds (ct: CancellationToken) e = + sw.Restart() + let swinfo = Some (sw, timeShareInMilliseconds) + steps ct swinfo e + + // Inlined for better stack traces, because inlining replaces ranges of the "runtime" code in the lambda + // with ranges in user code. let inline bind k e = let rec loop e = - match e with - | Done x -> k x - | Delimited (resourcef, ev2) -> - use _resource = resourcef() - loop ev2 - | NotYetDone work -> - NotYetDone (fun ct -> - match work ct with - | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce - | ValueOrCancelled.Value e2 -> ValueOrCancelled.Value (loop e2)) + NotYetDone (fun ct swinfo -> + let v = steps ct swinfo e + match v with + | ValueOrCancelled.Value (Done v) -> ValueOrCancelled.Value (k v) + | ValueOrCancelled.Value e2 -> ValueOrCancelled.Value (loop e2) + | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce) loop e + // Inlined for better stack traces, because inlining replaces ranges of the "runtime" code in the lambda + // with ranges in user code. + let inline map f e = bind (f >> ret) e + + // Inlined for better stack traces, because inlining replaces ranges of the "runtime" code in the lambda + // with ranges in user code. let inline fold f acc seq = (Done acc, seq) ||> Seq.fold (fun acc x -> acc |> bind (fun acc -> f acc x)) + // Inlined for better stack traces, because inlining replaces ranges of the "runtime" code in the lambda + // with ranges in user code. + let inline each f seq = + fold (fun acc x -> f x |> map (fun y -> y :: acc)) [] seq |> map List.rev + + // Catch by pushing exception handlers around all the work let inline catch e = let rec loop e = match e with | Done x -> Done(Result x) - | Delimited (resourcef, ev2) -> - use _resource = resourcef() - loop ev2 + | Delimited (resourcef, ev2) -> Delimited (resourcef, loop ev2) | NotYetDone work -> - NotYetDone (fun ct -> - let res = try Result(work ct) with | e -> Exception e + NotYetDone (fun ct swinfo -> + let res = try Result(work ct swinfo) with exn -> Exception exn match res with | Result (ValueOrCancelled.Value cont) -> ValueOrCancelled.Value (loop cont) | Result (ValueOrCancelled.Cancelled ce) -> ValueOrCancelled.Cancelled ce - | Exception e -> ValueOrCancelled.Value (Done(Exception e))) + | Exception exn -> ValueOrCancelled.Value (Done(Exception exn))) loop e - let inline delay f = NotYetDone (fun _ct -> ValueOrCancelled.Value (f ())) + let inline delay f = NotYetDone (fun _ct _swinfo -> ValueOrCancelled.Value (f ())) let inline tryFinally e compensation = catch e @@ -974,6 +975,8 @@ module Eventually = catch e |> bind (function Result v -> Done v | Exception e -> handler e) + let box e = map Operators.box e + let reusing resourcef e = Eventually.Delimited(resourcef, e) diff --git a/src/fsharp/absil/illib.fsi b/src/fsharp/absil/illib.fsi index 55a6c80e1ac..57e8593f730 100644 --- a/src/fsharp/absil/illib.fsi +++ b/src/fsharp/absil/illib.fsi @@ -371,7 +371,7 @@ module internal Cancellable = val fold : f:('a -> 'b -> Cancellable<'a>) -> acc:'a -> seq:seq<'b> -> Cancellable<'a> /// Iterate a cancellable computation over a collection - val each : f:('a -> Cancellable<'b>) -> seq:seq<'a> -> Cancellable<'b list> + val inline each : f:('a -> Cancellable<'b>) -> seq:seq<'a> -> Cancellable<'b list> /// Delay a cancellable computation val inline delay: f:(unit -> Cancellable<'T>) -> Cancellable<'T> @@ -427,23 +427,19 @@ type internal CancellableBuilder = module internal CancellableAutoOpens = val cancellable: CancellableBuilder -/// Cancellable computations that can cooperatively yield by returning a continuation +/// Cancellable computations that can cooperatively yield /// -/// - Any yield of a NotYetDone should typically be "abandonable" without adverse consequences. No resource release -/// will be called when the computation is abandoned. -/// -/// - Computations suspend via a NotYetDone may use local state (mutables), where these are -/// captured by the NotYetDone closure. Computations do not need to be restartable. -/// -/// - The key thing is that you can take an Eventually value and run it with -/// Eventually.forceForTimeSlice -type internal Eventually<'T> = - | Done of 'T - | NotYetDone of (CancellationToken -> ValueOrCancelled>) +/// - You can take an Eventually value and run it with Eventually.forceForTimeSlice +type internal Eventually<'T> = + | Done of 'T + | NotYetDone of (CancellationToken -> (Stopwatch * int64) option -> ValueOrCancelled>) | Delimited of (unit -> IDisposable) * Eventually<'T> module internal Eventually = + /// Return a simple value as the result of an eventually computation + val inline ret: x:'a -> Eventually<'a> + val box: e:Eventually<'a> -> Eventually // Throws away time-slicing but retains cancellation @@ -458,18 +454,39 @@ module internal Eventually = /// was detected. val forceForTimeSlice: sw:Stopwatch -> timeShareInMilliseconds: int64 -> ct: CancellationToken -> e: Eventually<'a> -> ValueOrCancelled> + /// Check if cancellation or time limit has been reached. Needed for inlined combinators + val stepCheck: ct: CancellationToken -> swinfo: (Stopwatch * int64) option -> e:'T -> ValueOrCancelled<'T> voption + + /// Take steps in the computation. Needed for inlined combinators. + [] + val steps: ct: CancellationToken -> swinfo: (Stopwatch * int64) option -> e:Eventually<'T> -> ValueOrCancelled> + + // Inlined for better stack traces, replacing ranges of the "runtime" code in the lambdas with ranges in user code. val inline map: f:('a -> 'b) -> e:Eventually<'a> -> Eventually<'b> + // Inlined for better stack traces, replacing ranges of the "runtime" code in the lambdas with ranges in user code. val inline bind: k:('a -> Eventually<'b>) -> e:Eventually<'a> -> Eventually<'b> + /// Fold a computation over a collection + // + // Inlined for better stack traces, replacing ranges of the "runtime" code in the lambdas with ranges in user code. val inline fold : f:('a -> 'b -> Eventually<'a>) -> acc:'a -> seq:seq<'b> -> Eventually<'a> + /// Map a computation over a collection + // + // Inlined for better stack traces, replacing ranges of the "runtime" code in the lambdas with ranges in user code. + val inline each : f:('a -> Eventually<'b>) -> seq:seq<'a> -> Eventually<'b list> + + // Inlined for better stack traces, replacing ranges of the "runtime" code in the lambdas with ranges in user code. val inline catch: e:Eventually<'a> -> Eventually> + // Inlined for better stack traces, replacing ranges of the "runtime" code in the lambdas with ranges in user code. val inline delay: f:(unit -> Eventually<'T>) -> Eventually<'T> + // Inlined for better stack traces, replacing ranges of the "runtime" code in the lambdas with ranges in user code. val inline tryFinally : e:Eventually<'a> -> compensation:(unit -> unit) -> Eventually<'a> + // Inlined for better stack traces, replacing ranges of the "runtime" code in the lambdas with ranges in user code. val inline tryWith : e:Eventually<'a> -> handler:(System.Exception -> Eventually<'a>) -> Eventually<'a> /// Bind the cancellation token associated with the computation @@ -482,6 +499,7 @@ module internal Eventually = val reusing: resourcef: (unit -> IDisposable) -> e:Eventually<'T> -> Eventually<'T> [] +// Inlined for better stack traces, replacing ranges of the "runtime" code in the lambdas with ranges in user code. type internal EventuallyBuilder = member inline BindReturn: e:Eventually<'g> * k:('g -> 'h) -> Eventually<'h> diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index 9c3ded5374e..8f119f01111 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -20,6 +20,7 @@ open FSharp.Compiler.ParseHelpers open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.SyntaxTreeOps +open FSharp.Compiler.SyntaxTreeOps open FSharp.Compiler.Text open FSharp.Compiler.Text.Position open FSharp.Compiler.Text.Range diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 0c4b739360b..3dadec23f0b 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -347,7 +347,7 @@ type BoundModel private (tcConfig: TcConfig, Some finishState) } - member this.TcInfo = + member this.GetTcInfo() = eventually { let! state = this.GetState(true) return state.TcInfo @@ -361,7 +361,7 @@ type BoundModel private (tcConfig: TcConfig, | PartialState(tcInfo) -> Some tcInfo | _ -> None - member this.TcInfoWithExtras = + member this.GetTcInfoWithExtras() = eventually { let! state = this.GetState(false) match state with @@ -585,19 +585,19 @@ type PartialCheckResults (boundModel: BoundModel, timeStamp: DateTime) = member _.TryTcInfo = boundModel.TryTcInfo - member _.GetTcInfo() = boundModel.TcInfo + member _.GetTcInfo() = boundModel.GetTcInfo() - member _.GetTcInfoWithExtras() = boundModel.TcInfoWithExtras + member _.GetTcInfoWithExtras() = boundModel.GetTcInfoWithExtras() member _.TryGetItemKeyStore() = eventually { - let! _, info = boundModel.TcInfoWithExtras + let! _, info = boundModel.GetTcInfoWithExtras() return info.itemKeyStore } member _.GetSemanticClassification() = eventually { - let! _, info = boundModel.TcInfoWithExtras + let! _, info = boundModel.GetTcInfoWithExtras() return info.semanticClassificationKeyStore } @@ -831,31 +831,33 @@ type IncrementalBuilder(tcGlobals, /// Finish up the typechecking to produce outputs for the rest of the compilation process let FinalizeTypeCheckTask ctok enablePartialTypeChecking (boundModels: ImmutableArray) = - cancellable { + eventually { DoesNotRequireCompilerThreadTokenAndCouldPossiblyBeMadeConcurrent ctok let errorLogger = CompilationErrorLogger("CombineImportedAssembliesTask", tcConfig.errorSeverityOptions) - use _holder = new CompilationGlobalsScope(errorLogger, BuildPhase.TypeCheck) - - // Get the state at the end of the type-checking of the last file - let finalBoundModel = boundModels.[boundModels.Length-1] - - let! finalInfo = finalBoundModel.TcInfo |> Eventually.toCancellable + // This reinstalls the CompilationGlobalsScope each time the Eventually is restarted, potentially + // on a new thread. This is needed because CompilationGlobalsScope installs thread local variables. + return! Eventually.reusing (fun () -> new CompilationGlobalsScope (errorLogger, BuildPhase.TypeCheck) :> IDisposable) <| eventually { let! results = - boundModels |> Cancellable.each (fun boundModel -> cancellable { + boundModels |> Eventually.each (fun boundModel -> eventually { let! tcInfo, latestImplFile = - cancellable { + eventually { if enablePartialTypeChecking then - let! tcInfo = boundModel.TcInfo |> Eventually.toCancellable + let! tcInfo = boundModel.GetTcInfo() return tcInfo, None else - let! tcInfo, tcInfoExtras = boundModel.TcInfoWithExtras |> Eventually.toCancellable + let! tcInfo, tcInfoExtras = boundModel.GetTcInfoWithExtras() return tcInfo, tcInfoExtras.latestImplFile } return (tcInfo.tcEnvAtEndOfFile, defaultArg tcInfo.topAttribs EmptyTopAttrs, latestImplFile, tcInfo.latestCcuSigForFile) }) + // Get the state at the end of the type-checking of the last file + let finalBoundModel = boundModels.[boundModels.Length-1] + + let! finalInfo = finalBoundModel.GetTcInfo() + // Finish the checking let (_tcEnvAtEndOfLastFile, topAttrs, mimpls, _), tcState = TypeCheckMultipleInputsFinish (results, finalInfo.tcState) @@ -915,9 +917,11 @@ type IncrementalBuilder(tcGlobals, errorRecoveryNoRange e mkSimpleAssemblyRef assemblyName, None, None - let! finalBoundModelWithErrors = finalBoundModel.Finish((errorLogger.GetDiagnostics() :: finalInfo.tcErrorsRev), Some topAttrs) |> Eventually.toCancellable + let diagnostics = errorLogger.GetDiagnostics() :: finalInfo.tcErrorsRev + let! finalBoundModelWithErrors = finalBoundModel.Finish(diagnostics, Some topAttrs) return ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt, finalBoundModelWithErrors } + } // END OF BUILD TASK FUNCTIONS // --------------------------------------------------------------------------------------------- @@ -1002,9 +1006,7 @@ type IncrementalBuilder(tcGlobals, boundModels = Array.init count (fun _ -> None) |> ImmutableArray.CreateRange } else - { state with - stampedReferencedAssemblies = stampedReferencedAssemblies.ToImmutable() - } + state let computeInitialBoundModel (state: IncrementalBuilderState) (ctok: CompilationThreadToken) = eventually { @@ -1021,13 +1023,13 @@ type IncrementalBuilder(tcGlobals, if IncrementalBuild.injectCancellationFault then Eventually.canceled() else eventually { - let! (state, initial) = computeInitialBoundModel state ctok - let fileInfo = fileNames.[slot] let state = computeStampedFileName state cache slot fileInfo if state.boundModels.[slot].IsNone then + let! (state, initial) = computeInitialBoundModel state ctok + let prevBoundModel = match slot with | 0 (* first file *) -> initial @@ -1054,32 +1056,19 @@ type IncrementalBuilder(tcGlobals, (state, [0..fileNames.Length-1]) ||> Eventually.fold (fun state slot -> computeBoundModel state cache ctok slot) let computeFinalizedBoundModel state (cache: TimeStampCache) (ctok: CompilationThreadToken) = - cancellable { - let! state = computeBoundModels state cache ctok |> Eventually.toCancellable + eventually { + let! state = computeBoundModels state cache ctok match state.finalizedBoundModel with | Some result -> return state, result | _ -> let boundModels = state.boundModels |> Seq.choose id |> ImmutableArray.CreateRange - let! result = FinalizeTypeCheckTask ctok state.enablePartialTypeChecking boundModels + let! result = FinalizeTypeCheckTask ctok state.enablePartialTypeChecking boundModels let result = (result, DateTime.UtcNow) return { state with finalizedBoundModel = Some result }, result } - let populateBoundModel state (cache: TimeStampCache) (ctok: CompilationThreadToken) = - eventually { - let state = computeStampedReferencedAssemblies state cache - let state = computeStampedFileNames state cache - - match state.boundModels |> Seq.tryFindIndex (fun x -> x.IsNone) with - | Some slot -> - let! state = computeBoundModel state cache ctok slot - return state, true - | _ -> - return state, false - } - let tryGetBeforeSlot (state: IncrementalBuilderState) slot = match slot with | 0 (* first file *) -> @@ -1097,18 +1086,14 @@ type IncrementalBuilder(tcGlobals, | _ -> None - let eval state (cache: TimeStampCache) ctok targetSlot = + let evalUpToTargetSlot state (cache: TimeStampCache) ctok targetSlot = cancellable { + let state = computeStampedReferencedAssemblies state cache if targetSlot < 0 then - let state = computeStampedReferencedAssemblies state cache - let! state, result = computeInitialBoundModel state ctok |> Eventually.toCancellable return state, Some(result, DateTime.MinValue) else - let state = computeStampedReferencedAssemblies state cache - let! state = - (state, [0..targetSlot]) ||> Cancellable.fold (fun state slot -> - computeBoundModel state cache ctok slot |> Eventually.toCancellable) + let! state = (state, [0..targetSlot]) ||> Eventually.fold (fun state slot -> computeBoundModel state cache ctok slot) |> Eventually.toCancellable let result = state.boundModels.[targetSlot] @@ -1123,7 +1108,7 @@ type IncrementalBuilder(tcGlobals, cancellable { let state = computeStampedReferencedAssemblies state cache - let! state, res = computeFinalizedBoundModel state cache ctok + let! state, res = computeFinalizedBoundModel state cache ctok |> Eventually.toCancellable return state, Some res } @@ -1178,10 +1163,16 @@ type IncrementalBuilder(tcGlobals, member _.PopulatePartialCheckingResults (ctok: CompilationThreadToken) = eventually { let cache = TimeStampCache defaultTimeStamp // One per step - let! state, res = populateBoundModel currentState cache ctok + let state = currentState + let state = computeStampedFileNames state cache + setCurrentState ctok state + do! Eventually.ret () // allow cancellation + let state = computeStampedReferencedAssemblies state cache + setCurrentState ctok state + do! Eventually.ret () // allow cancellation + let! state, _res = computeFinalizedBoundModel state cache ctok setCurrentState ctok state - if not res then - projectChecked.Trigger() + projectChecked.Trigger() } member builder.GetCheckResultsBeforeFileInProjectEvenIfStale filename: PartialCheckResults option = @@ -1213,7 +1204,7 @@ type IncrementalBuilder(tcGlobals, member private _.GetCheckResultsBeforeSlotInProject (ctok: CompilationThreadToken, slotOfFile, enablePartialTypeChecking) = cancellable { let cache = TimeStampCache defaultTimeStamp - let! state, result = eval { currentState with enablePartialTypeChecking = enablePartialTypeChecking } cache ctok (slotOfFile - 1) + let! state, result = evalUpToTargetSlot { currentState with enablePartialTypeChecking = enablePartialTypeChecking } cache ctok (slotOfFile - 1) setCurrentState ctok { state with enablePartialTypeChecking = defaultPartialTypeChecking } match result with | Some (boundModel, timestamp) -> return PartialCheckResults(boundModel, timestamp) diff --git a/src/fsharp/service/Reactor.fs b/src/fsharp/service/Reactor.fs index 68fe32a698e..35f9f404baa 100755 --- a/src/fsharp/service/Reactor.fs +++ b/src/fsharp/service/Reactor.fs @@ -197,12 +197,12 @@ type Reactor() = // This is for testing only member r.WaitForBackgroundOpCompletion() = - Trace.TraceInformation("Reactor: {0:n3} enqueue wait for background, length {0}", DateTime.Now.TimeOfDay.TotalSeconds, builder.CurrentQueueLength) + Trace.TraceInformation("Reactor: {0:n3} enqueue wait for background, length {1}", DateTime.Now.TimeOfDay.TotalSeconds, builder.CurrentQueueLength) builder.PostAndReply WaitForBackgroundOpCompletion // This is for testing only member r.CompleteAllQueuedOps() = - Trace.TraceInformation("Reactor: {0:n3} enqueue wait for all ops, length {0}", DateTime.Now.TimeOfDay.TotalSeconds, builder.CurrentQueueLength) + Trace.TraceInformation("Reactor: {0:n3} enqueue wait for all ops, length {1}", DateTime.Now.TimeOfDay.TotalSeconds, builder.CurrentQueueLength) builder.PostAndReply CompleteAllQueuedOps member r.EnqueueAndAwaitOpAsync (userOpName, opName, opArg, f) = diff --git a/src/fsharp/service/service.fs b/src/fsharp/service/service.fs index 1275eab9aea..30aab3c66bd 100644 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -394,15 +394,15 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC hash (fun (f1, o1, v1) (f2, o2, v2) -> f1 = f2 && v1 = v2 && FSharpProjectOptions.AreSameForChecking(o1, o2))) - static let mutable foregroundParseCount = 0 + static let mutable actualParseFileCount = 0 - static let mutable foregroundTypeCheckCount = 0 + static let mutable actualCheckFileCount = 0 member _.RecordCheckFileInProjectResults(filename,options,parsingOptions,parseResults,fileVersion,priorTimeStamp,checkAnswer,sourceText) = match checkAnswer with | None -> () | Some typedResults -> - foregroundTypeCheckCount <- foregroundTypeCheckCount + 1 + actualCheckFileCount <- actualCheckFileCount + 1 parseCacheLock.AcquireLock (fun ltok -> checkFileInProjectCachePossiblyStale.Set(ltok, (filename,options),(parseResults,typedResults,fileVersion)) checkFileInProjectCache.Set(ltok, (filename, sourceText, options),(parseResults,typedResults,fileVersion,priorTimeStamp)) @@ -419,7 +419,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC match parseCacheLock.AcquireLock(fun ltok -> parseFileCache.TryGet(ltok, (filename, hash, options))) with | Some res -> return res | None -> - foregroundParseCount <- foregroundParseCount + 1 + actualParseFileCount <- actualParseFileCount + 1 let parseDiags, parseTree, anyErrors = ParseAndCheckFile.parseFile(sourceText, filename, options, userOpName, suggestNamesForErrors) let res = FSharpParseFileResults(parseDiags, parseTree, anyErrors, options.SourceFiles) parseCacheLock.AcquireLock(fun ltok -> parseFileCache.Set(ltok, (filename, hash, options), res)) @@ -995,9 +995,9 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC member _.ImplicitlyStartBackgroundWork with get() = implicitlyStartBackgroundWork and set v = implicitlyStartBackgroundWork <- v - static member GlobalForegroundParseCountStatistic = foregroundParseCount + static member ActualParseFileCount = actualParseFileCount - static member GlobalForegroundTypeCheckCountStatistic = foregroundTypeCheckCount + static member ActualCheckFileCount = actualCheckFileCount [] @@ -1285,8 +1285,15 @@ type FSharpChecker(legacyReferenceResolver, let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.GetProjectOptionsFromScript(filename, source, previewEnabled, loadedTimeStamp, otherFlags, useFsiAuxLib, useSdkRefs, sdkDirOverride, assumeDotNetFramework, optionsStamp, userOpName) - member _.GetProjectOptionsFromCommandLineArgs(projectFileName, argv, ?loadedTimeStamp) = + member _.GetProjectOptionsFromCommandLineArgs(projectFileName, argv, ?loadedTimeStamp, ?isInteractive, ?isEditing) = + let isEditing = defaultArg isEditing false + let isInteractive = defaultArg isInteractive false let loadedTimeStamp = defaultArg loadedTimeStamp DateTime.MaxValue // Not 'now', we don't want to force reloading + let argv = + let define = if isInteractive then "--define:INTERACTIVE" else "--define:COMPILED" + Array.append argv [| define |] + let argv = + if isEditing then Array.append argv [| "--define:EDITING" |] else argv { ProjectFileName = projectFileName ProjectId = None SourceFiles = [| |] // the project file names will be inferred from the ProjectOptions @@ -1299,10 +1306,11 @@ type FSharpChecker(legacyReferenceResolver, OriginalLoadReferences=[] Stamp = None } - member _.GetParsingOptionsFromCommandLineArgs(sourceFiles, argv, ?isInteractive) = + member _.GetParsingOptionsFromCommandLineArgs(sourceFiles, argv, ?isInteractive, ?isEditing) = + let isEditing = defaultArg isEditing false let isInteractive = defaultArg isInteractive false use errorScope = new ErrorScope() - let tcConfigBuilder = + let tcConfigB = TcConfigBuilder.CreateNew(legacyReferenceResolver, defaultFSharpBinariesDir=FSharpCheckerResultsSettings.defaultFSharpBinariesDir, reduceMemoryUsage=ReduceMemoryFlag.Yes, @@ -1314,12 +1322,19 @@ type FSharpChecker(legacyReferenceResolver, sdkDirOverride=None, rangeForErrors=range0) + // These defines are implied by the F# compiler + tcConfigB.conditionalCompilationDefines <- + let define = if isInteractive then "INTERACTIVE" else "COMPILED" + define :: tcConfigB.conditionalCompilationDefines + if isEditing then + tcConfigB.conditionalCompilationDefines <- "EDITING":: tcConfigB.conditionalCompilationDefines + // Apply command-line arguments and collect more source files if they are in the arguments - let sourceFilesNew = ApplyCommandLineArgs(tcConfigBuilder, sourceFiles, argv) - FSharpParsingOptions.FromTcConfigBuilder(tcConfigBuilder, Array.ofList sourceFilesNew, isInteractive), errorScope.Diagnostics + let sourceFilesNew = ApplyCommandLineArgs(tcConfigB, sourceFiles, argv) + FSharpParsingOptions.FromTcConfigBuilder(tcConfigB, Array.ofList sourceFilesNew, isInteractive), errorScope.Diagnostics - member ic.GetParsingOptionsFromCommandLineArgs(argv, ?isInteractive: bool) = - ic.GetParsingOptionsFromCommandLineArgs([], argv, ?isInteractive=isInteractive) + member ic.GetParsingOptionsFromCommandLineArgs(argv, ?isInteractive: bool, ?isEditing) = + ic.GetParsingOptionsFromCommandLineArgs([], argv, ?isInteractive=isInteractive, ?isEditing=isEditing) /// Begin background parsing the given project. member _.StartBackgroundCompile(options, ?userOpName) = @@ -1356,9 +1371,9 @@ type FSharpChecker(legacyReferenceResolver, member _.PauseBeforeBackgroundWork with get() = Reactor.Singleton.PauseBeforeBackgroundWork and set v = Reactor.Singleton.PauseBeforeBackgroundWork <- v - static member GlobalForegroundParseCountStatistic = BackgroundCompiler.GlobalForegroundParseCountStatistic + static member ActualParseFileCount = BackgroundCompiler.ActualParseFileCount - static member GlobalForegroundTypeCheckCountStatistic = BackgroundCompiler.GlobalForegroundTypeCheckCountStatistic + static member ActualCheckFileCount = BackgroundCompiler.ActualCheckFileCount member _.MaxMemoryReached = maxMemEvent.Publish diff --git a/src/fsharp/service/service.fsi b/src/fsharp/service/service.fsi index cf5725f18f5..0e5d5c9218e 100644 --- a/src/fsharp/service/service.fsi +++ b/src/fsharp/service/service.fsi @@ -171,9 +171,17 @@ type public FSharpChecker = /// An optional unique stamp for the options. /// An optional string used for tracing compiler operations associated with this request. member GetProjectOptionsFromScript: - filename: string * source: ISourceText * ?previewEnabled:bool * ?loadedTimeStamp: DateTime * - ?otherFlags: string[] * ?useFsiAuxLib: bool * ?useSdkRefs: bool * ?assumeDotNetFramework: bool * ?sdkDirOverride: string * - ?optionsStamp: int64 * ?userOpName: string + filename: string * + source: ISourceText * + ?previewEnabled:bool * + ?loadedTimeStamp: DateTime * + ?otherFlags: string[] * + ?useFsiAuxLib: bool * + ?useSdkRefs: bool * + ?assumeDotNetFramework: bool * + ?sdkDirOverride: string * + ?optionsStamp: int64 * + ?userOpName: string -> Async /// Get the FSharpProjectOptions implied by a set of command line arguments. @@ -181,12 +189,16 @@ type public FSharpChecker = /// Used to differentiate between projects and for the base directory of the project. /// The command line arguments for the project build. /// Indicates when the script was loaded into the editing environment, + /// Indicates that compilation should assume the EDITING define and related settings + /// Indicates that compilation should assume the INTERACTIVE define and related settings /// so that an 'unload' and 'reload' action will cause the script to be considered as a new project, /// so that references are re-resolved. member GetProjectOptionsFromCommandLineArgs: projectFileName: string * argv: string[] * - ?loadedTimeStamp: DateTime + ?loadedTimeStamp: DateTime * + ?isInteractive: bool * + ?isEditing: bool -> FSharpProjectOptions /// @@ -196,10 +208,12 @@ type public FSharpChecker = /// Initial source files list. Additional files may be added during argv evaluation. /// The command line arguments for the project build. /// Indicates that parsing should assume the INTERACTIVE define and related settings + /// Indicates that compilation should assume the EDITING define and related settings member GetParsingOptionsFromCommandLineArgs: sourceFiles: string list * argv: string list * - ?isInteractive: bool + ?isInteractive: bool * + ?isEditing: bool -> FSharpParsingOptions * FSharpDiagnostic list /// @@ -208,14 +222,21 @@ type public FSharpChecker = /// /// The command line arguments for the project build. /// Indicates that parsing should assume the INTERACTIVE define and related settings - member GetParsingOptionsFromCommandLineArgs: argv: string list * ?isInteractive: bool -> FSharpParsingOptions * FSharpDiagnostic list + /// Indicates that compilation should assume the EDITING define and related settings + member GetParsingOptionsFromCommandLineArgs: + argv: string list * + ?isInteractive: bool * + ?isEditing: bool + -> FSharpParsingOptions * FSharpDiagnostic list /// /// Get the FSharpParsingOptions implied by a FSharpProjectOptions. /// /// /// The overall options. - member GetParsingOptionsFromProjectOptions: options: FSharpProjectOptions -> FSharpParsingOptions * FSharpDiagnostic list + member GetParsingOptionsFromProjectOptions: + options: FSharpProjectOptions + -> FSharpParsingOptions * FSharpDiagnostic list /// /// Like ParseFile, but uses results from the background builder. @@ -359,10 +380,10 @@ type public FSharpChecker = member WaitForBackgroundCompile: unit -> unit /// Report a statistic for testability - static member GlobalForegroundParseCountStatistic: int + static member ActualParseFileCount: int /// Report a statistic for testability - static member GlobalForegroundTypeCheckCountStatistic: int + static member ActualCheckFileCount: int /// Flush all caches and garbage collect member ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients: unit -> unit diff --git a/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs b/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs index 19729206812..55aca926c74 100644 --- a/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs +++ b/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs @@ -1425,16 +1425,16 @@ FSharp.Compiler.CodeAnalysis.FSharpChecker: Boolean get_ImplicitlyStartBackgroun FSharp.Compiler.CodeAnalysis.FSharpChecker: FSharp.Compiler.CodeAnalysis.FSharpChecker Create(Microsoft.FSharp.Core.FSharpOption`1[System.Int32], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.CodeAnalysis.LegacyReferenceResolver], Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Core.FSharpFunc`2[System.Tuple`2[System.String,System.DateTime],Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`3[System.Object,System.IntPtr,System.Int32]]]], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean]) FSharp.Compiler.CodeAnalysis.FSharpChecker: FSharp.Compiler.CodeAnalysis.FSharpChecker Instance FSharp.Compiler.CodeAnalysis.FSharpChecker: FSharp.Compiler.CodeAnalysis.FSharpChecker get_Instance() -FSharp.Compiler.CodeAnalysis.FSharpChecker: FSharp.Compiler.CodeAnalysis.FSharpProjectOptions GetProjectOptionsFromCommandLineArgs(System.String, System.String[], Microsoft.FSharp.Core.FSharpOption`1[System.DateTime]) +FSharp.Compiler.CodeAnalysis.FSharpChecker: FSharp.Compiler.CodeAnalysis.FSharpProjectOptions GetProjectOptionsFromCommandLineArgs(System.String, System.String[], Microsoft.FSharp.Core.FSharpOption`1[System.DateTime], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean]) FSharp.Compiler.CodeAnalysis.FSharpChecker: FSharp.Compiler.Tokenization.FSharpTokenInfo[][] TokenizeFile(System.String) +FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 ActualCheckFileCount +FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 ActualParseFileCount FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 CurrentQueueLength -FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 GlobalForegroundParseCountStatistic -FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 GlobalForegroundTypeCheckCountStatistic FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 MaxMemory FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 PauseBeforeBackgroundWork +FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 get_ActualCheckFileCount() +FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 get_ActualParseFileCount() FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 get_CurrentQueueLength() -FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 get_GlobalForegroundParseCountStatistic() -FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 get_GlobalForegroundTypeCheckCountStatistic() FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 get_MaxMemory() FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 get_PauseBeforeBackgroundWork() FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Control.FSharpAsync`1[FSharp.Compiler.CodeAnalysis.FSharpCheckFileAnswer] CheckFileInProject(FSharp.Compiler.CodeAnalysis.FSharpParseFileResults, System.String, Int32, FSharp.Compiler.Text.ISourceText, FSharp.Compiler.CodeAnalysis.FSharpProjectOptions, Microsoft.FSharp.Core.FSharpOption`1[System.String]) @@ -1466,8 +1466,8 @@ FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Control.IEvent`2[Mi FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Control.IEvent`2[Microsoft.FSharp.Control.FSharpHandler`1[System.Tuple`2[System.String,FSharp.Compiler.CodeAnalysis.FSharpProjectOptions]],System.Tuple`2[System.String,FSharp.Compiler.CodeAnalysis.FSharpProjectOptions]] get_FileChecked() FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Control.IEvent`2[Microsoft.FSharp.Control.FSharpHandler`1[System.Tuple`2[System.String,FSharp.Compiler.CodeAnalysis.FSharpProjectOptions]],System.Tuple`2[System.String,FSharp.Compiler.CodeAnalysis.FSharpProjectOptions]] get_FileParsed() FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`3[FSharp.Compiler.CodeAnalysis.FSharpParseFileResults,FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults,System.Int32]] TryGetRecentCheckResultsForFile(System.String, FSharp.Compiler.CodeAnalysis.FSharpProjectOptions, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.ISourceText], Microsoft.FSharp.Core.FSharpOption`1[System.String]) -FSharp.Compiler.CodeAnalysis.FSharpChecker: System.Tuple`2[FSharp.Compiler.CodeAnalysis.FSharpParsingOptions,Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Diagnostics.FSharpDiagnostic]] GetParsingOptionsFromCommandLineArgs(Microsoft.FSharp.Collections.FSharpList`1[System.String], Microsoft.FSharp.Collections.FSharpList`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean]) -FSharp.Compiler.CodeAnalysis.FSharpChecker: System.Tuple`2[FSharp.Compiler.CodeAnalysis.FSharpParsingOptions,Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Diagnostics.FSharpDiagnostic]] GetParsingOptionsFromCommandLineArgs(Microsoft.FSharp.Collections.FSharpList`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean]) +FSharp.Compiler.CodeAnalysis.FSharpChecker: System.Tuple`2[FSharp.Compiler.CodeAnalysis.FSharpParsingOptions,Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Diagnostics.FSharpDiagnostic]] GetParsingOptionsFromCommandLineArgs(Microsoft.FSharp.Collections.FSharpList`1[System.String], Microsoft.FSharp.Collections.FSharpList`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean]) +FSharp.Compiler.CodeAnalysis.FSharpChecker: System.Tuple`2[FSharp.Compiler.CodeAnalysis.FSharpParsingOptions,Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Diagnostics.FSharpDiagnostic]] GetParsingOptionsFromCommandLineArgs(Microsoft.FSharp.Collections.FSharpList`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean]) FSharp.Compiler.CodeAnalysis.FSharpChecker: System.Tuple`2[FSharp.Compiler.CodeAnalysis.FSharpParsingOptions,Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Diagnostics.FSharpDiagnostic]] GetParsingOptionsFromProjectOptions(FSharp.Compiler.CodeAnalysis.FSharpProjectOptions) FSharp.Compiler.CodeAnalysis.FSharpChecker: System.Tuple`2[FSharp.Compiler.Tokenization.FSharpTokenInfo[],FSharp.Compiler.Tokenization.FSharpTokenizerLexState] TokenizeLine(System.String, FSharp.Compiler.Tokenization.FSharpTokenizerLexState) FSharp.Compiler.CodeAnalysis.FSharpChecker: Void CheckProjectInBackground(FSharp.Compiler.CodeAnalysis.FSharpProjectOptions, Microsoft.FSharp.Core.FSharpOption`1[System.String]) diff --git a/tests/service/PerfTests.fs b/tests/service/PerfTests.fs index 140f9f7c848..5b77c6d2f59 100644 --- a/tests/service/PerfTests.fs +++ b/tests/service/PerfTests.fs @@ -44,11 +44,11 @@ let ``Test request for parse and check doesn't check whole project`` () = checker.FileParsed.Add (fun x -> incr backgroundParseCount) checker.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() - let pB, tB = FSharpChecker.GlobalForegroundParseCountStatistic, FSharpChecker.GlobalForegroundTypeCheckCountStatistic + let pB, tB = FSharpChecker.ActualParseFileCount, FSharpChecker.ActualCheckFileCount printfn "ParseFile()..." let parseResults1 = checker.ParseFile(Project1.fileNames.[5], Project1.fileSources2.[5], Project1.parsingOptions) |> Async.RunSynchronously - let pC, tC = FSharpChecker.GlobalForegroundParseCountStatistic, FSharpChecker.GlobalForegroundTypeCheckCountStatistic + let pC, tC = FSharpChecker.ActualParseFileCount, FSharpChecker.ActualCheckFileCount (pC - pB) |> shouldEqual 1 (tC - tB) |> shouldEqual 0 printfn "checking backgroundParseCount.Value = %d" backgroundParseCount.Value @@ -58,7 +58,7 @@ let ``Test request for parse and check doesn't check whole project`` () = printfn "CheckFileInProject()..." let checkResults1 = checker.CheckFileInProject(parseResults1, Project1.fileNames.[5], 0, Project1.fileSources2.[5], Project1.options) |> Async.RunSynchronously - let pD, tD = FSharpChecker.GlobalForegroundParseCountStatistic, FSharpChecker.GlobalForegroundTypeCheckCountStatistic + let pD, tD = FSharpChecker.ActualParseFileCount, FSharpChecker.ActualCheckFileCount printfn "checking background parsing happened...., backgroundParseCount.Value = %d" backgroundParseCount.Value (backgroundParseCount.Value >= 5) |> shouldEqual true // but note, the project does not get reparsed @@ -77,7 +77,7 @@ let ``Test request for parse and check doesn't check whole project`` () = printfn "CheckFileInProject()..." let checkResults2 = checker.CheckFileInProject(parseResults1, Project1.fileNames.[7], 0, Project1.fileSources2.[7], Project1.options) |> Async.RunSynchronously - let pE, tE = FSharpChecker.GlobalForegroundParseCountStatistic, FSharpChecker.GlobalForegroundTypeCheckCountStatistic + let pE, tE = FSharpChecker.ActualParseFileCount, FSharpChecker.ActualCheckFileCount printfn "checking no extra foreground parsing...., (pE - pD) = %d" (pE - pD) (pE - pD) |> shouldEqual 0 printfn "checking one foreground typecheck...., tE - tD = %d" (tE - tD) @@ -90,7 +90,7 @@ let ``Test request for parse and check doesn't check whole project`` () = printfn "ParseAndCheckFileInProject()..." // A subsequent ParseAndCheck of identical source code doesn't do any more anything let checkResults2 = checker.ParseAndCheckFileInProject(Project1.fileNames.[7], 0, Project1.fileSources2.[7], Project1.options) |> Async.RunSynchronously - let pF, tF = FSharpChecker.GlobalForegroundParseCountStatistic, FSharpChecker.GlobalForegroundTypeCheckCountStatistic + let pF, tF = FSharpChecker.ActualParseFileCount, FSharpChecker.ActualCheckFileCount printfn "checking no extra foreground parsing...." (pF - pE) |> shouldEqual 0 // note, no new parse of the file printfn "checking no extra foreground typechecks...." diff --git a/tests/service/ProjectAnalysisTests.fs b/tests/service/ProjectAnalysisTests.fs index b5a8883ae46..341f5f236c3 100644 --- a/tests/service/ProjectAnalysisTests.fs +++ b/tests/service/ProjectAnalysisTests.fs @@ -4564,7 +4564,7 @@ module internal Project36 = let base2 = Path.GetTempFileName() let dllName = Path.ChangeExtension(base2, ".dll") let projFileName = Path.ChangeExtension(base2, ".fsproj") - let fileSource1 = """ + let fileSource1 = """module Project36 type A(i:int) = member x.Value = i @@ -4584,26 +4584,16 @@ let callToOverload = B(5).Overload(4) let fileNames = [fileName1] let args = mkProjectCommandLineArgs (dllName, fileNames) + +[] +let ``Test project36 FSharpMemberOrFunctionOrValue.IsBaseValue`` () = let keepAssemblyContentsChecker = FSharpChecker.Create(keepAssemblyContents=true) - let options = keepAssemblyContentsChecker.GetProjectOptionsFromCommandLineArgs (projFileName, args) + let options = keepAssemblyContentsChecker.GetProjectOptionsFromCommandLineArgs (Project36.projFileName, Project36.args) let wholeProjectResults = keepAssemblyContentsChecker.ParseAndCheckProject(options) |> Async.RunSynchronously - let declarations = - let checkedFile = wholeProjectResults.AssemblyContents.ImplementationFiles.[0] - match checkedFile.Declarations.[0] with - | FSharpImplementationFileDeclaration.Entity (_, subDecls) -> subDecls - | _ -> failwith "unexpected declaration" - let getExpr exprIndex = - match declarations.[exprIndex] with - | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(_,_,e) -> e - | FSharpImplementationFileDeclaration.InitAction e -> e - | _ -> failwith "unexpected declaration" - -[] -let ``Test project36 FSharpMemberOrFunctionOrValue.IsBaseValue`` () = - Project36.wholeProjectResults.GetAllUsesOfAllSymbols() + wholeProjectResults.GetAllUsesOfAllSymbols() |> Array.pick (fun (su:FSharpSymbolUse) -> if su.Symbol.DisplayName = "base" then Some (su.Symbol :?> FSharpMemberOrFunctionOrValue) @@ -4612,7 +4602,9 @@ let ``Test project36 FSharpMemberOrFunctionOrValue.IsBaseValue`` () = [] let ``Test project36 FSharpMemberOrFunctionOrValue.IsConstructorThisValue & IsMemberThisValue`` () = - let wholeProjectResults = Project36.keepAssemblyContentsChecker.ParseAndCheckProject(Project36.options) |> Async.RunSynchronously + let keepAssemblyContentsChecker = FSharpChecker.Create(keepAssemblyContents=true) + let options = keepAssemblyContentsChecker.GetProjectOptionsFromCommandLineArgs (Project36.projFileName, Project36.args) + let wholeProjectResults = keepAssemblyContentsChecker.ParseAndCheckProject(options) |> Async.RunSynchronously let declarations = let checkedFile = wholeProjectResults.AssemblyContents.ImplementationFiles.[0] match checkedFile.Declarations.[0] with @@ -4627,19 +4619,19 @@ let ``Test project36 FSharpMemberOrFunctionOrValue.IsConstructorThisValue & IsMe // the correct values are also visible from there. Also note you cannot use // ThisValue in these cases, this is only used when the symbol // is implicit in the constructor - match Project36.getExpr 4 with + match getExpr 4 with | Let((b,_),_) -> b.IsConstructorThisValue && not b.IsMemberThisValue | _ -> failwith "unexpected expression" |> shouldEqual true - match Project36.getExpr 5 with + match getExpr 5 with | FSharpFieldGet(Some(Value x),_,_) -> x.IsMemberThisValue && not x.IsConstructorThisValue | _ -> failwith "unexpected expression" |> shouldEqual true - match Project36.getExpr 6 with + match getExpr 6 with | Call(_,_,_,_,[Value s;_]) -> not s.IsMemberThisValue && not s.IsConstructorThisValue | _ -> failwith "unexpected expression" @@ -4647,7 +4639,9 @@ let ``Test project36 FSharpMemberOrFunctionOrValue.IsConstructorThisValue & IsMe [] let ``Test project36 FSharpMemberOrFunctionOrValue.LiteralValue`` () = - let wholeProjectResults = Project36.keepAssemblyContentsChecker.ParseAndCheckProject(Project36.options) |> Async.RunSynchronously + let keepAssemblyContentsChecker = FSharpChecker.Create(keepAssemblyContents=true) + let options = keepAssemblyContentsChecker.GetProjectOptionsFromCommandLineArgs (Project36.projFileName, Project36.args) + let wholeProjectResults = keepAssemblyContentsChecker.ParseAndCheckProject(options) |> Async.RunSynchronously let project36Module = wholeProjectResults.AssemblySignature.Entities.[0] let lit = project36Module.MembersFunctionsAndValues.[0] shouldEqual true (lit.LiteralValue.Value |> unbox |> (=) 1.) @@ -5209,7 +5203,8 @@ let foo (a: Foo): bool = [] let ``Test typed AST for struct unions`` () = // See https://github.com/fsharp/FSharp.Compiler.Service/issues/756 - let wholeProjectResults = Project36.keepAssemblyContentsChecker.ParseAndCheckProject(ProjectStructUnions.options) |> Async.RunSynchronously + let keepAssemblyContentsChecker = FSharpChecker.Create(keepAssemblyContents=true) + let wholeProjectResults = keepAssemblyContentsChecker.ParseAndCheckProject(ProjectStructUnions.options) |> Async.RunSynchronously let declarations = let checkedFile = wholeProjectResults.AssemblyContents.ImplementationFiles.[0] match checkedFile.Declarations.[0] with diff --git a/vsintegration/src/FSharp.LanguageService/FSharpSource.fs b/vsintegration/src/FSharp.LanguageService/FSharpSource.fs index 2136681f55a..b311983e6b4 100644 --- a/vsintegration/src/FSharp.LanguageService/FSharpSource.fs +++ b/vsintegration/src/FSharp.LanguageService/FSharpSource.fs @@ -355,6 +355,7 @@ type internal FSharpSource_DEPRECATED(service:LanguageService_DEPRECATED, textLi yield! pi.CompilationOptions |> Array.filter(fun flag -> flag.StartsWith("--define:")) | None -> () yield "--noframework" + yield "--define:COMPILED" |] // get a sync parse of the file diff --git a/vsintegration/tests/UnitTests/TestLib.LanguageService.fs b/vsintegration/tests/UnitTests/TestLib.LanguageService.fs index dc3d649200d..c33223c6ff0 100644 --- a/vsintegration/tests/UnitTests/TestLib.LanguageService.fs +++ b/vsintegration/tests/UnitTests/TestLib.LanguageService.fs @@ -159,7 +159,7 @@ type internal GlobalParseAndTypeCheckCounter private(initialParseCount:int, init static member StartNew(vs) = TakeCoffeeBreak(vs) let n = IncrementalBuilderEventTesting.GetCurrentIncrementalBuildEventNum() - new GlobalParseAndTypeCheckCounter(FSharpChecker.GlobalForegroundParseCountStatistic, FSharpChecker.GlobalForegroundTypeCheckCountStatistic, n, vs) + new GlobalParseAndTypeCheckCounter(FSharpChecker.ActualParseFileCount, FSharpChecker.ActualCheckFileCount, n, vs) member private this.GetEvents() = TakeCoffeeBreak(vs) let n = IncrementalBuilderEventTesting.GetCurrentIncrementalBuildEventNum() From b7d9e9f529a19f4485f45ae5a1948bc17809d331 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 3 Mar 2021 00:23:09 +0000 Subject: [PATCH 13/15] fix bug with concurrent cancellation - Type Provider Disposal Smoke Test --- src/fsharp/service/Reactor.fs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/fsharp/service/Reactor.fs b/src/fsharp/service/Reactor.fs index 35f9f404baa..7cce06c779f 100755 --- a/src/fsharp/service/Reactor.fs +++ b/src/fsharp/service/Reactor.fs @@ -86,8 +86,9 @@ type Reactor() = match bgOpOpt with | None -> None | Some (bgUserOpName, bgOpName, bgOpArg, bgOp) -> - bgOpCts.Dispose() + let oldBgOpCts = bgOpCts bgOpCts <- new CancellationTokenSource() + oldBgOpCts.Dispose() Some (bgUserOpName, bgOpName, bgOpArg, bgOp ctok) //Trace.TraceInformation("Reactor: --> set background op, remaining {0}", inbox.CurrentQueueLength) @@ -112,8 +113,9 @@ type Reactor() = | None -> () | Some (bgUserOpName, bgOpName, bgOpArg, bgOp) -> Trace.TraceInformation("Reactor: {0:n3} --> wait for background {1}.{2} ({3}), remaining {4}", DateTime.Now.TimeOfDay.TotalSeconds, bgUserOpName, bgOpName, bgOpArg, inbox.CurrentQueueLength) - bgOpCts.Dispose() + let oldBgOpCts = bgOpCts bgOpCts <- new CancellationTokenSource() + oldBgOpCts.Dispose() try Eventually.force bgOpCts.Token bgOp |> ignore From 663666d12d522b42e195f33f77fc50aff9765ae3 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 3 Mar 2021 13:19:37 +0000 Subject: [PATCH 14/15] fix build break --- src/fsharp/lex.fsl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/lex.fsl b/src/fsharp/lex.fsl index 8ce8763a4a7..96f85e74734 100644 --- a/src/fsharp/lex.fsl +++ b/src/fsharp/lex.fsl @@ -981,7 +981,7 @@ rule token args skip = parse | anywhite* "#else" ident_char+ | anywhite* "#endif" ident_char+ | anywhite* "#light" ident_char+ - { let n = Array.IndexOf(lexbuf.Lexeme, '#') + { let n = (lexeme lexbuf).IndexOf('#') lexbuf.StartPos <- lexbuf.StartPos.ShiftColumnBy(n) HASH_IDENT(lexemeTrimLeft lexbuf (n+1)) } From 4b4e3d8fbefe5a1ca4718b410b078cb0839a0968 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 3 Mar 2021 14:45:04 +0000 Subject: [PATCH 15/15] cleanup --- src/fsharp/absil/illib.fs | 22 +++++++++++----------- src/fsharp/service/Reactor.fs | 14 +++++++------- 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/src/fsharp/absil/illib.fs b/src/fsharp/absil/illib.fs index 8f8e9036f80..fa0fb872aa7 100644 --- a/src/fsharp/absil/illib.fs +++ b/src/fsharp/absil/illib.fs @@ -851,20 +851,20 @@ module Eventually = // with ranges in user code. let inline toCancellable e = Cancellable (fun ct -> - let rec loop e = + let rec toCancellableAux e = match e with | Done x -> ValueOrCancelled.Value x | Delimited (resourcef, ev2) -> use _resource = resourcef() - loop ev2 + toCancellableAux ev2 | NotYetDone work -> if ct.IsCancellationRequested then ValueOrCancelled.Cancelled (OperationCanceledException ct) else match work ct None with | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce - | ValueOrCancelled.Value e2 -> loop e2 - loop e) + | ValueOrCancelled.Value e2 -> toCancellableAux e2 + toCancellableAux e) // Inlined for better stack traces, because inlining replaces ranges of the "runtime" code in the lambda // with ranges in user code. @@ -923,14 +923,14 @@ module Eventually = // Inlined for better stack traces, because inlining replaces ranges of the "runtime" code in the lambda // with ranges in user code. let inline bind k e = - let rec loop e = + let rec bindAux e = NotYetDone (fun ct swinfo -> let v = steps ct swinfo e match v with | ValueOrCancelled.Value (Done v) -> ValueOrCancelled.Value (k v) - | ValueOrCancelled.Value e2 -> ValueOrCancelled.Value (loop e2) + | ValueOrCancelled.Value e2 -> ValueOrCancelled.Value (bindAux e2) | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce) - loop e + bindAux e // Inlined for better stack traces, because inlining replaces ranges of the "runtime" code in the lambda // with ranges in user code. @@ -948,18 +948,18 @@ module Eventually = // Catch by pushing exception handlers around all the work let inline catch e = - let rec loop e = + let rec catchAux e = match e with | Done x -> Done(Result x) - | Delimited (resourcef, ev2) -> Delimited (resourcef, loop ev2) + | Delimited (resourcef, ev2) -> Delimited (resourcef, catchAux ev2) | NotYetDone work -> NotYetDone (fun ct swinfo -> let res = try Result(work ct swinfo) with exn -> Exception exn match res with - | Result (ValueOrCancelled.Value cont) -> ValueOrCancelled.Value (loop cont) + | Result (ValueOrCancelled.Value cont) -> ValueOrCancelled.Value (catchAux cont) | Result (ValueOrCancelled.Cancelled ce) -> ValueOrCancelled.Cancelled ce | Exception exn -> ValueOrCancelled.Value (Done(Exception exn))) - loop e + catchAux e let inline delay f = NotYetDone (fun _ct _swinfo -> ValueOrCancelled.Value (f ())) diff --git a/src/fsharp/service/Reactor.fs b/src/fsharp/service/Reactor.fs index 7cce06c779f..5f5eebe711a 100755 --- a/src/fsharp/service/Reactor.fs +++ b/src/fsharp/service/Reactor.fs @@ -177,33 +177,33 @@ type Reactor() = | None -> () // [Foreground Mailbox Accessors] ----------------------------------------------------------- - member r.SetBackgroundOp(bgOpOpt) = + member _.SetBackgroundOp(bgOpOpt) = Trace.TraceInformation("Reactor: {0:n3} enqueue start background, length {1}", DateTime.Now.TimeOfDay.TotalSeconds, builder.CurrentQueueLength) bgOpCts.Cancel() builder.Post(SetBackgroundOp bgOpOpt) - member r.CancelBackgroundOp() = + member _.CancelBackgroundOp() = Trace.TraceInformation("FCS: trying to cancel any active background work") bgOpCts.Cancel() - member r.EnqueueOp(userOpName, opName, opArg, op) = + member _.EnqueueOp(userOpName, opName, opArg, op) = Trace.TraceInformation("Reactor: {0:n3} enqueue {1}.{2} ({3}), length {4}", DateTime.Now.TimeOfDay.TotalSeconds, userOpName, opName, opArg, builder.CurrentQueueLength) builder.Post(Op(userOpName, opName, opArg, CancellationToken.None, op, (fun () -> ()))) - member r.EnqueueOpPrim(userOpName, opName, opArg, ct, op, ccont) = + member _.EnqueueOpPrim(userOpName, opName, opArg, ct, op, ccont) = Trace.TraceInformation("Reactor: {0:n3} enqueue {1}.{2} ({3}), length {4}", DateTime.Now.TimeOfDay.TotalSeconds, userOpName, opName, opArg, builder.CurrentQueueLength) builder.Post(Op(userOpName, opName, opArg, ct, op, ccont)) - member r.CurrentQueueLength = + member _.CurrentQueueLength = builder.CurrentQueueLength // This is for testing only - member r.WaitForBackgroundOpCompletion() = + member _.WaitForBackgroundOpCompletion() = Trace.TraceInformation("Reactor: {0:n3} enqueue wait for background, length {1}", DateTime.Now.TimeOfDay.TotalSeconds, builder.CurrentQueueLength) builder.PostAndReply WaitForBackgroundOpCompletion // This is for testing only - member r.CompleteAllQueuedOps() = + member _.CompleteAllQueuedOps() = Trace.TraceInformation("Reactor: {0:n3} enqueue wait for all ops, length {1}", DateTime.Now.TimeOfDay.TotalSeconds, builder.CurrentQueueLength) builder.PostAndReply CompleteAllQueuedOps