From 4403766bfc9936a8d494bc751765034c042f5fa9 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 23 Aug 2022 02:56:47 +0100 Subject: [PATCH 01/33] revamp parallel checking --- src/Compiler/Checking/CheckBasics.fs | 3 +- src/Compiler/Checking/CheckBasics.fsi | 1 - src/Compiler/Checking/CheckDeclarations.fs | 10 +- src/Compiler/Checking/CheckDeclarations.fsi | 12 +- src/Compiler/CodeGen/IlxGen.fs | 7 +- src/Compiler/Driver/CompilerConfig.fs | 14 +- src/Compiler/Driver/CompilerDiagnostics.fsi | 6 +- src/Compiler/Driver/CompilerImports.fs | 8 +- src/Compiler/Driver/CompilerOptions.fs | 2 +- src/Compiler/Driver/ParseAndCheckInputs.fs | 553 +++++++++++++----- src/Compiler/Driver/ParseAndCheckInputs.fsi | 36 +- src/Compiler/Driver/ScriptClosure.fs | 12 +- src/Compiler/Driver/fsc.fs | 47 +- src/Compiler/Facilities/DiagnosticsLogger.fs | 32 +- src/Compiler/Facilities/DiagnosticsLogger.fsi | 47 +- src/Compiler/Interactive/fsi.fs | 33 +- .../Legacy/LegacyHostedCompilerForTesting.fs | 9 +- src/Compiler/Service/FSharpCheckerResults.fs | 39 +- src/Compiler/Service/IncrementalBuild.fs | 5 +- src/Compiler/Service/ServiceLexing.fs | 8 +- src/Compiler/Service/service.fs | 9 +- src/Compiler/Symbols/FSharpDiagnostic.fs | 8 +- src/Compiler/SyntaxTree/LexHelpers.fs | 2 +- src/Compiler/TypedTree/CompilerGlobalState.fs | 4 +- src/Compiler/Utilities/lib.fs | 10 + src/Compiler/Utilities/lib.fsi | 15 + src/fsc/fscmain.fs | 2 +- 27 files changed, 636 insertions(+), 298 deletions(-) diff --git a/src/Compiler/Checking/CheckBasics.fs b/src/Compiler/Checking/CheckBasics.fs index e6fb4014376..18f457ef887 100644 --- a/src/Compiler/Checking/CheckBasics.fs +++ b/src/Compiler/Checking/CheckBasics.fs @@ -328,13 +328,14 @@ type TcFileState = /// Create a new compilation environment static member Create - (g, isScript, niceNameGen, amap, thisCcu, isSig, haveSig, conditionalDefines, tcSink, tcVal, isInternalTestSpanStackReferring, + (g, isScript, amap, thisCcu, isSig, haveSig, conditionalDefines, tcSink, tcVal, isInternalTestSpanStackReferring, tcPat, tcSimplePats, tcSequenceExpressionEntry, tcArrayOrListSequenceExpression, tcComputationExpression) = + let niceNameGen = NiceNameGenerator() let infoReader = InfoReader(g, amap) let instantiationGenerator m tpsorig = FreshenTypars g m tpsorig let nameResolver = NameResolver(g, amap, infoReader, instantiationGenerator) diff --git a/src/Compiler/Checking/CheckBasics.fsi b/src/Compiler/Checking/CheckBasics.fsi index 0a156d268d1..389b716e1c8 100644 --- a/src/Compiler/Checking/CheckBasics.fsi +++ b/src/Compiler/Checking/CheckBasics.fsi @@ -311,7 +311,6 @@ type TcFileState = static member Create: g: TcGlobals * isScript: bool * - niceNameGen: NiceNameGenerator * amap: ImportMap * thisCcu: CcuThunk * isSig: bool * diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 0d9b0df134b..d4c3644fcf1 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -5157,7 +5157,7 @@ let MakeInitialEnv env = /// Typecheck, then close the inference scope and then check the file meets its signature (if any) let CheckOneImplFile // checkForErrors: A function to help us stop reporting cascading errors - (g, niceNameGen, amap, + (g, amap, thisCcu, openDecls0, checkForErrors, @@ -5173,7 +5173,7 @@ let CheckOneImplFile cancellable { let cenv = - cenv.Create (g, isScript, niceNameGen, amap, thisCcu, false, Option.isSome rootSigOpt, + cenv.Create (g, isScript, amap, thisCcu, false, Option.isSome rootSigOpt, conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g), isInternalTestSpanStackReferring, tcPat=TcPat, tcSimplePats=TcSimplePats, @@ -5291,17 +5291,17 @@ let CheckOneImplFile let implFile = CheckedImplFile (qualNameOfFile, scopedPragmas, implFileTy, implFileContents, hasExplicitEntryPoint, isScript, anonRecdTypes, namedDebugPointsForInlinedCode) - return (topAttrs, implFile, implFileTypePriorToSig, envAtEnd, cenv.createsGeneratedProvidedTypes) + return (topAttrs, implFile, envAtEnd, cenv.createsGeneratedProvidedTypes) } /// Check an entire signature file -let CheckOneSigFile (g, niceNameGen, amap, thisCcu, checkForErrors, conditionalDefines, tcSink, isInternalTestSpanStackReferring) tcEnv (ParsedSigFileInput (qualifiedNameOfFile = qualNameOfFile; modules = sigFileFrags)) = +let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSink, isInternalTestSpanStackReferring) tcEnv (ParsedSigFileInput (qualifiedNameOfFile = qualNameOfFile; modules = sigFileFrags)) = cancellable { let cenv = cenv.Create - (g, false, niceNameGen, amap, thisCcu, true, false, conditionalDefines, tcSink, + (g, false, amap, thisCcu, true, false, conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g), isInternalTestSpanStackReferring, tcPat=TcPat, tcSimplePats=TcSimplePats, diff --git a/src/Compiler/Checking/CheckDeclarations.fsi b/src/Compiler/Checking/CheckDeclarations.fsi index 8a858bca0c4..00033bfb9d6 100644 --- a/src/Compiler/Checking/CheckDeclarations.fsi +++ b/src/Compiler/Checking/CheckDeclarations.fsi @@ -49,7 +49,6 @@ val AddLocalSubModule: val CheckOneImplFile: TcGlobals * - NiceNameGenerator * ImportMap * CcuThunk * OpenDeclaration list * @@ -60,17 +59,10 @@ val CheckOneImplFile: TcEnv * ModuleOrNamespaceType option * ParsedImplFileInput -> - Cancellable + Cancellable val CheckOneSigFile: - TcGlobals * - NiceNameGenerator * - ImportMap * - CcuThunk * - (unit -> bool) * - ConditionalDefines option * - TcResultsSink * - bool -> + TcGlobals * ImportMap * CcuThunk * (unit -> bool) * ConditionalDefines option * TcResultsSink * bool -> TcEnv -> ParsedSigFileInput -> Cancellable diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 4064cdd1896..796979490e0 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -11552,6 +11552,11 @@ let CodegenAssembly cenv eenv mgbuf implFiles = match List.tryFrontAndBack implFiles with | None -> () | Some (firstImplFiles, lastImplFile) -> + + // Generate the assembly sequentially, implementation file by implementation file. + // + // NOTE: In theory this could be done in parallel, except for the presence of linear + // state in the AssemblyBuilder let eenv = List.fold (GenImplFile cenv mgbuf None) eenv firstImplFiles let eenv = GenImplFile cenv mgbuf cenv.options.mainMethodInfo eenv lastImplFile @@ -11626,7 +11631,7 @@ type IlxGenResults = let GenerateCode (cenv, anonTypeTable, eenv, CheckedAssemblyAfterOptimization implFiles, assemAttribs, moduleAttribs) = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.IlxGen + use _ = UseThreadBuildPhase BuildPhase.IlxGen let g = cenv.g // Generate the implementations into the mgbuf diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs index 55ac85b9a3a..2bac1b37d97 100644 --- a/src/Compiler/Driver/CompilerConfig.fs +++ b/src/Compiler/Driver/CompilerConfig.fs @@ -797,7 +797,7 @@ type TcConfigBuilder = tcConfigB.fxResolver <- None // this needs to be recreated when the primary assembly changes member tcConfigB.ResolveSourceFile(m, nm, pathLoadedFrom) = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseThreadBuildPhase BuildPhase.Parameter let paths = seq { @@ -809,7 +809,7 @@ type TcConfigBuilder = /// Decide names of output file, pdb and assembly member tcConfigB.DecideNames sourceFiles = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseThreadBuildPhase BuildPhase.Parameter if sourceFiles = [] then errorR (Error(FSComp.SR.buildNoInputsSpecified (), rangeCmdArgs)) @@ -860,7 +860,7 @@ type TcConfigBuilder = outfile, pdbfile, assemblyName member tcConfigB.TurnWarningOff(m, s: string) = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseThreadBuildPhase BuildPhase.Parameter match GetWarningNumber(m, s) with | None -> () @@ -875,7 +875,7 @@ type TcConfigBuilder = } member tcConfigB.TurnWarningOn(m, s: string) = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseThreadBuildPhase BuildPhase.Parameter match GetWarningNumber(m, s) with | None -> () @@ -1309,7 +1309,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member _.exiter = data.exiter static member Create(builder, validate) = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseThreadBuildPhase BuildPhase.Parameter TcConfig(builder, validate) member _.legacyReferenceResolver = data.legacyReferenceResolver @@ -1326,7 +1326,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member _.GetTargetFrameworkDirectories() = targetFrameworkDirectories member tcConfig.ComputeIndentationAwareSyntaxInitialStatus fileName = - use _unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _unwindBuildPhase = UseThreadBuildPhase BuildPhase.Parameter let indentationAwareSyntaxOnByDefault = List.exists (FileSystemUtils.checkSuffix fileName) FSharpIndentationAwareSyntaxFileSuffixes @@ -1337,7 +1337,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = (tcConfig.indentationAwareSyntax = Some true) member tcConfig.GetAvailableLoadedSources() = - use _unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _unwindBuildPhase = UseThreadBuildPhase BuildPhase.Parameter let resolveLoadedSource (m, originalPath, path) = try diff --git a/src/Compiler/Driver/CompilerDiagnostics.fsi b/src/Compiler/Driver/CompilerDiagnostics.fsi index 8f76210f91f..565269961aa 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fsi +++ b/src/Compiler/Driver/CompilerDiagnostics.fsi @@ -77,7 +77,11 @@ val OutputDiagnosticContext: /// Get an error logger that filters the reporting of warnings based on scoped pragma information val GetDiagnosticsLoggerFilteringByScopedPragmas: - checkFile: bool * ScopedPragma list * FSharpDiagnosticOptions * DiagnosticsLogger -> DiagnosticsLogger + checkFile: bool * + scopedPragmas: ScopedPragma list * + diagnosticOptions: FSharpDiagnosticOptions * + diagnosticsLogger: DiagnosticsLogger -> + DiagnosticsLogger val SanitizeFileName: fileName: string -> implicitIncludeDir: string -> string diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index 0958224400d..bbac0d200f6 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -382,7 +382,7 @@ type TcConfig with member tcConfig.TryResolveLibWithDirectories(r: AssemblyReference) = let m, nm = r.Range, r.Text - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseThreadBuildPhase BuildPhase.Parameter // See if the language service has already produced the contents of the assembly for us, virtually match r.ProjectReference with @@ -436,7 +436,7 @@ type TcConfig with member tcConfig.ResolveLibWithDirectories(ccuLoadFailureAction, r: AssemblyReference) = let m, nm = r.Range, r.Text - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseThreadBuildPhase BuildPhase.Parameter let rs = if IsExe nm || IsDLL nm || IsNetModule nm then @@ -504,7 +504,7 @@ type TcConfig with mode: ResolveAssemblyReferenceMode ) : AssemblyResolution list * UnresolvedAssemblyReference list = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseThreadBuildPhase BuildPhase.Parameter if tcConfig.useSimpleResolution then failwith "MSBuild resolution is not supported." @@ -801,7 +801,7 @@ type TcAssemblyResolutions(tcConfig: TcConfig, results: AssemblyResolution list, TcAssemblyResolutions.ResolveAssemblyReferences(tcConfig, references, knownUnresolved) static member GetAssemblyResolutionInformation(tcConfig: TcConfig) = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseThreadBuildPhase BuildPhase.Parameter let assemblyList = TcAssemblyResolutions.GetAllDllReferences tcConfig let resolutions = diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index 2a950193cc1..a8db6f6d6db 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -257,7 +257,7 @@ module ResponseFile = Choice2Of2 e let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: CompilerOptionBlock list, args) = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseThreadBuildPhase BuildPhase.Parameter let specs = List.collect GetOptionsOfBlock blocks diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 041c13bb493..840e7a0d665 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -426,8 +426,8 @@ let ParseInput // Delay sending errors and warnings until after the file is parsed. This gives us a chance to scrape the // #nowarn declarations for the file let delayLogger = CapturingDiagnosticsLogger("Parsing") - use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> delayLogger) - use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse + use _ = UseDiagnosticsLogger delayLogger + use _ = UseThreadBuildPhase BuildPhase.Parse let mutable scopedPragmas = [] @@ -550,7 +550,7 @@ let EmptyParsedInput (fileName, isLastCompiland) = /// Parse an input, drawing tokens from the LexBuffer let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, lexbuf, fileName, isLastCompiland, diagnosticsLogger) = - use unwindbuildphase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse + use unwindbuildphase = UseThreadBuildPhase BuildPhase.Parse try @@ -734,8 +734,73 @@ let ParseOneInputFile (tcConfig: TcConfig, lexResourceManager, fileName, isLastC errorRecovery exn rangeStartup EmptyParsedInput(fileName, isLastCompiland) -/// Parse multiple input files from disk -let ParseInputFiles +(* +let ProcessInParallel + ( + workSpecs, + diagnosticsLogger: DiagnosticsLogger, + exiter: Exiter, + createDiagnosticsLogger: Exiter -> CapturingDiagnosticsLogger + ) = + + let workSpecs = + workSpecs + |> Array.ofList + + let results = + try + try + workSpecs + |> ArrayParallel.mapi (fun i work -> + work () + ) + finally + for logger in capturingDiagnosticLoggers do + logger.CommitDelayedDiagnostics diagnosticsLogger + with StopProcessing -> + if exitCode > 0 then + exiter.Exit exitCode + else + reraise() + + results |> List.ofArray +*) + +/// Prepare to process inputs independently, e.g. partially in parallel. +/// +/// To do this we create one CapturingDiagnosticLogger for each input and +/// then ensure the diagnostics are presented in deterministic order after processing completes. +/// On completion all diagnostics are forwarded to the DiagnosticLogger given as input. +/// +/// NOTE: Max errors is currently counted separately for each logger. When max errors is reached on one compilation +/// the given Exiter will be called. +/// +/// NOTE: this needs to be improved to commit diagnotics as soon as possible +/// +/// NOTE: If StopProcessing is raised by any piece of work then the overall function raises StopProcessing. +let UseMultipleDiagnosticLoggers + (inputs, exiter: Exiter, diagnosticsLogger, createDiagnosticsLogger: Exiter -> CapturingDiagnosticsLogger) + f + = + let delayedExiter = StopProcessingExiter() + + // Check input files and create delayed error loggers before we try to parallel parse. + let capturingDiagnosticLoggers = + inputs |> List.map (fun _ -> createDiagnosticsLogger delayedExiter) + + try + try + f (List.zip inputs capturingDiagnosticLoggers) + finally + for logger in capturingDiagnosticLoggers do + logger.CommitDelayedDiagnostics diagnosticsLogger + with StopProcessing -> + if delayedExiter.ExitCode > 0 then + exiter.Exit delayedExiter.ExitCode + else + reraise () + +let ParseInputFilesInParallel ( tcConfig: TcConfig, lexResourceManager, @@ -744,64 +809,62 @@ let ParseInputFiles createDiagnosticsLogger: Exiter -> CapturingDiagnosticsLogger, retryLocked ) = - try - let isLastCompiland, isExe = sourceFiles |> tcConfig.ComputeCanContainEntryPoint - let sourceFiles = isLastCompiland |> List.zip sourceFiles |> Array.ofList - if tcConfig.concurrentBuild then - let mutable exitCode = 0 + let isLastCompiland, isExe = sourceFiles |> tcConfig.ComputeCanContainEntryPoint - let delayedExiter = - { new Exiter with - member _.Exit n = - exitCode <- n - raise StopProcessing - } + for fileName in sourceFiles do + checkInputFile tcConfig fileName - // Check input files and create delayed error loggers before we try to parallel parse. - let delayedDiagnosticsLoggers = - sourceFiles - |> Array.map (fun (fileName, _) -> - checkInputFile tcConfig fileName - createDiagnosticsLogger delayedExiter) - - let results = - try - try - sourceFiles - |> ArrayParallel.mapi (fun i (fileName, isLastCompiland) -> - let delayedDiagnosticsLogger = delayedDiagnosticsLoggers[i] - - let directoryName = Path.GetDirectoryName fileName - - let input = - parseInputFileAux ( - tcConfig, - lexResourceManager, - fileName, - (isLastCompiland, isExe), - delayedDiagnosticsLogger, - retryLocked - ) - - (input, directoryName)) - finally - delayedDiagnosticsLoggers - |> Array.iter (fun delayedDiagnosticsLogger -> delayedDiagnosticsLogger.CommitDelayedDiagnostics diagnosticsLogger) - with StopProcessing -> - tcConfig.exiter.Exit exitCode - - results |> List.ofArray - else - sourceFiles - |> Array.map (fun (fileName, isLastCompiland) -> - let directoryName = Path.GetDirectoryName fileName + let sourceFiles = List.zip sourceFiles isLastCompiland + + UseMultipleDiagnosticLoggers (sourceFiles, exiter, diagnosticsLogger, createDiagnosticsLogger) (fun sourceFilesWithCapturingLoggers -> + sourceFilesWithCapturingLoggers + |> ListParallel.map (fun ((fileName, isLastCompiland), capturingDiagnosticLogger) -> + let directoryName = Path.GetDirectoryName fileName + + let input = + parseInputFileAux (tcConfig, lexResourceManager, fileName, (isLastCompiland, isExe), capturingDiagnosticLogger, retryLocked) + + (input, directoryName))) + +let ParseInputFilesSequential (tcConfig: TcConfig, lexResourceManager, sourceFiles, diagnosticsLogger: DiagnosticsLogger, retryLocked) = + let isLastCompiland, isExe = sourceFiles |> tcConfig.ComputeCanContainEntryPoint + let sourceFiles = isLastCompiland |> List.zip sourceFiles |> Array.ofList + + sourceFiles + |> Array.map (fun (fileName, isLastCompiland) -> + let directoryName = Path.GetDirectoryName fileName - let input = - ParseOneInputFile(tcConfig, lexResourceManager, fileName, (isLastCompiland, isExe), diagnosticsLogger, retryLocked) + let input = + ParseOneInputFile(tcConfig, lexResourceManager, fileName, (isLastCompiland, isExe), diagnosticsLogger, retryLocked) + + (input, directoryName)) + |> List.ofArray - (input, directoryName)) - |> List.ofArray +/// Parse multiple input files from disk +let ParseInputFiles + ( + tcConfig: TcConfig, + lexResourceManager, + sourceFiles, + diagnosticsLogger: DiagnosticsLogger, + exiter: Exiter, + createDiagnosticsLogger: Exiter -> CapturingDiagnosticsLogger, + retryLocked + ) = + try + if tcConfig.concurrentBuild then + ParseInputFilesInParallel( + tcConfig, + lexResourceManager, + sourceFiles, + diagnosticsLogger, + exiter, + createDiagnosticsLogger, + retryLocked + ) + else + ParseInputFilesSequential(tcConfig, lexResourceManager, sourceFiles, diagnosticsLogger, retryLocked) with e -> errorRecoveryNoRange e @@ -814,7 +877,7 @@ let ProcessMetaCommandsFromInput (tcConfig: TcConfigBuilder, inp: ParsedInput, pathOfMetaCommandSource, state0) = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse + use _ = UseThreadBuildPhase BuildPhase.Parse let canHaveScriptMetaCommands = match inp with @@ -1033,22 +1096,34 @@ let qnameOrder = Order.orderBy (fun (q: QualifiedNameOfFile) -> q.Text) type TcState = { + /// The assembly thunk for the assembly being compiled. tcsCcu: CcuThunk - tcsCcuType: ModuleOrNamespace - tcsNiceNameGen: NiceNameGenerator + + /// The typing environment implied by the set of signature files and/or inferred signatures of implementation files checked so far tcsTcSigEnv: TcEnv + + /// The typing environment implied by the set of implementation files checked so far tcsTcImplEnv: TcEnv + + /// Indicates if any implementation file so far includes use of generative provided types tcsCreatesGeneratedProvidedTypes: bool + + /// A table of signature files processed so far, indexed by QualifiedNameOfFile, to help give better diagnostics + /// if there are mismatches in module names between signature and implementation files with the same name. tcsRootSigs: RootSigs + + /// A table of implementation files processed so far, indexed by QualifiedNameOfFile, to help give better diagnostics + /// if there are mismatches in module names between signature and implementation files with the same name. tcsRootImpls: RootImpls + + /// The combined partial assembly signature resulting from all the signatures and/or inferred signatures of implementation files + /// so far. tcsCcuSig: ModuleOrNamespaceType - /// The collected open declarations implied by '/checked' flag and processing F# interactive fragments that have an implied module. + /// The collected implicit open declarations implied by '/checked' flag and processing F# interactive fragments that have an implied module. tcsImplicitOpenDeclarations: OpenDeclaration list } - member x.NiceNameGenerator = x.tcsNiceNameGen - member x.TcEnvFromSignatures = x.tcsTcSigEnv member x.TcEnvFromImpls = x.tcsTcImplEnv @@ -1057,9 +1132,6 @@ type TcState = member x.CreatesGeneratedProvidedTypes = x.tcsCreatesGeneratedProvidedTypes - // Assem(a.fsi + b.fsi + c.fsi) (after checking implementation file ) - member x.CcuType = x.tcsCcuType - // a.fsi + b.fsi + c.fsi (after checking implementation file for c.fs) member x.CcuSig = x.tcsCcuSig @@ -1069,8 +1141,13 @@ type TcState = tcsTcImplEnv = tcEnvAtEndOfLastInput } + member x.RemoveImpl qualifiedNameOfFile = + { x with + tcsRootImpls = x.tcsRootImpls.Remove(qualifiedNameOfFile) + } + /// Create the initial type checking state for compiling an assembly -let GetInitialTcState (m, ccuName, tcConfig: TcConfig, tcGlobals, tcImports: TcImports, niceNameGen, tcEnv0, openDecls0) = +let GetInitialTcState (m, ccuName, tcConfig: TcConfig, tcGlobals, tcImports: TcImports, tcEnv0, openDecls0) = ignore tcImports // Create a ccu to hold all the results of compilation @@ -1106,8 +1183,6 @@ let GetInitialTcState (m, ccuName, tcConfig: TcConfig, tcGlobals, tcImports: TcI { tcsCcu = ccu - tcsCcuType = ccuContents - tcsNiceNameGen = niceNameGen tcsTcSigEnv = tcEnv0 tcsTcImplEnv = tcEnv0 tcsCreatesGeneratedProvidedTypes = false @@ -1121,8 +1196,66 @@ let GetInitialTcState (m, ccuName, tcConfig: TcConfig, tcGlobals, tcImports: TcI let CreateEmptyDummyImplFile qualNameOfFile sigTy = CheckedImplFile.CheckedImplFile(qualNameOfFile, [], sigTy, ModuleOrNamespaceContents.TMDefs [], false, false, StampMap [], Map.empty) +let AddCheckResultsToTcState + (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcImplEnv, qualNameOfFile, implFileSigType) + (tcState: TcState) + = + + let rootImpls = Zset.add qualNameOfFile tcState.tcsRootImpls + + // Only add it to the environment if it didn't have a signature + let m = qualNameOfFile.Range + + // Add the implementation as to the implementation env + let tcImplEnv = + AddLocalRootModuleOrNamespace TcResultsSink.NoSink tcGlobals amap m tcImplEnv implFileSigType + + // Add the implementation as to the signature env (unless it had an explicit signature) + let tcSigEnv = + if hadSig then + tcState.tcsTcSigEnv + else + AddLocalRootModuleOrNamespace TcResultsSink.NoSink tcGlobals amap m tcState.tcsTcSigEnv implFileSigType + + // Open the prefixPath for fsi.exe (tcImplEnv) + let tcImplEnv, openDecls = + match prefixPathOpt with + | Some prefixPath -> TcOpenModuleOrNamespaceDecl tcSink tcGlobals amap m tcImplEnv (prefixPath, m) + | _ -> tcImplEnv, [] + + // Open the prefixPath for fsi.exe (tcSigEnv) + let tcSigEnv, _ = + match prefixPathOpt with + | Some prefixPath when not hadSig -> TcOpenModuleOrNamespaceDecl tcSink tcGlobals amap m tcSigEnv (prefixPath, m) + | _ -> tcSigEnv, [] + + let ccuSigForFile = + CombineCcuContentFragments m [ implFileSigType; tcState.tcsCcuSig ] + + let tcState = + { tcState with + tcsTcSigEnv = tcSigEnv + tcsTcImplEnv = tcImplEnv + tcsRootImpls = rootImpls + tcsCcuSig = ccuSigForFile + tcsImplicitOpenDeclarations = tcState.tcsImplicitOpenDeclarations @ openDecls + } + + ccuSigForFile, tcState + +let AddDummyCheckResultsToTcState (tcGlobals, amap, file, prefixPathOpt, tcSink, tcState: TcState, tcStateForImplFile: TcState, rootSig) = + let (ParsedImplFileInput (qualifiedNameOfFile = qualNameOfFile)) = file + let hadSig = true + let emptyImplFile = CreateEmptyDummyImplFile qualNameOfFile rootSig + let tcEnvAtEnd = tcStateForImplFile.TcEnvFromImpls + + let ccuSigForFile, tcState = + AddCheckResultsToTcState (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, rootSig) tcState + + (tcEnvAtEnd, EmptyTopAttrs, Some emptyImplFile, ccuSigForFile), tcState + /// Typecheck a single file (or interactive entry into F# Interactive) -let CheckOneInput +let CheckOneInputAux ( checkForErrors, tcConfig: TcConfig, @@ -1163,7 +1296,6 @@ let CheckOneInput let! tcEnv, sigFileType, createsGeneratedProvidedTypes = CheckOneSigFile (tcGlobals, - tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, @@ -1194,9 +1326,10 @@ let CheckOneInput tcsCreatesGeneratedProvidedTypes = tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes } - return (tcEnv, EmptyTopAttrs, None, ccuSigForFile), tcState + return Choice1Of2(tcEnv, EmptyTopAttrs, None, ccuSigForFile), tcState - | ParsedInput.ImplFile (ParsedImplFileInput (qualifiedNameOfFile = qualNameOfFile) as file) -> + | ParsedInput.ImplFile file -> + let (ParsedImplFileInput (qualifiedNameOfFile = qualNameOfFile)) = file // Check if we've got an interface for this fragment let rootSigOpt = tcState.tcsRootSigs.TryFind qualNameOfFile @@ -1205,8 +1338,6 @@ let CheckOneInput if Zset.contains qualNameOfFile tcState.tcsRootImpls then errorR (Error(FSComp.SR.buildImplementationAlreadyGiven (qualNameOfFile.Text), m)) - let tcImplEnv = tcState.tcsTcImplEnv - let conditionalDefines = if tcConfig.noConditionalErasure then None @@ -1215,15 +1346,32 @@ let CheckOneInput let hadSig = rootSigOpt.IsSome - // Typecheck the implementation file - let typeCheckOne = - if skipImplIfSigExists && hadSig then - (EmptyTopAttrs, CreateEmptyDummyImplFile qualNameOfFile rootSigOpt.Value, Unchecked.defaultof<_>, tcImplEnv, false) - |> cancellable.Return - else + match rootSigOpt with + | Some rootSig when skipImplIfSigExists -> + // Delay the typecheck the implementation file until the second phase of parallel processing. + // Adjust the TcState as if it has been checked, which makes the signature for the file available later + // in the compilation order. + let tcStateForImplFile = tcState + //let ccuSigForFile, tcState = AddDummyCheckResultsToTcState (tcGlobals, amap, file, prefixPathOpt, tcSink, tcState, tcStateForImplFile, rootSig) + let (ParsedImplFileInput (qualifiedNameOfFile = qualNameOfFile)) = file + let hadSig = true + //let emptyImplFile = CreateEmptyDummyImplFile qualNameOfFile rootSig + //let tcEnvAtEnd = tcStateForImplFile.TcEnvFromImpls + let ccuSigForFile, tcState = + AddCheckResultsToTcState + (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, rootSig) + tcState + + let partialResult = + (amap, conditionalDefines, rootSig, file, tcStateForImplFile, ccuSigForFile) + + return Choice2Of2 partialResult, tcState + + | _ -> + // Typecheck the implementation file + let! topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes = CheckOneImplFile( tcGlobals, - tcState.tcsNiceNameGen, amap, tcState.tcsCcu, tcState.tcsImplicitOpenDeclarations, @@ -1231,75 +1379,68 @@ let CheckOneInput conditionalDefines, tcSink, tcConfig.internalTestSpanStackReferring, - tcImplEnv, + tcState.tcsTcImplEnv, rootSigOpt, file ) - let! topAttrs, implFile, _implFileHiddenType, tcEnvAtEnd, createsGeneratedProvidedTypes = typeCheckOne + let tcState = + { tcState with + tcsCreatesGeneratedProvidedTypes = tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes + } - let implFileSigType = implFile.Signature + let ccuSigForFile, tcState = + AddCheckResultsToTcState + (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, implFile.Signature) + tcState - let rootImpls = Zset.add qualNameOfFile tcState.tcsRootImpls - - // Only add it to the environment if it didn't have a signature - let m = qualNameOfFile.Range - - // Add the implementation as to the implementation env - let tcImplEnv = - AddLocalRootModuleOrNamespace TcResultsSink.NoSink tcGlobals amap m tcImplEnv implFileSigType - - // Add the implementation as to the signature env (unless it had an explicit signature) - let tcSigEnv = - if hadSig then - tcState.tcsTcSigEnv - else - AddLocalRootModuleOrNamespace TcResultsSink.NoSink tcGlobals amap m tcState.tcsTcSigEnv implFileSigType - - // Open the prefixPath for fsi.exe (tcImplEnv) - let tcImplEnv, openDecls = - match prefixPathOpt with - | Some prefixPath -> TcOpenModuleOrNamespaceDecl tcSink tcGlobals amap m tcImplEnv (prefixPath, m) - | _ -> tcImplEnv, [] - - // Open the prefixPath for fsi.exe (tcSigEnv) - let tcSigEnv, _ = - match prefixPathOpt with - | Some prefixPath when not hadSig -> TcOpenModuleOrNamespaceDecl tcSink tcGlobals amap m tcSigEnv (prefixPath, m) - | _ -> tcSigEnv, [] - - let ccuSigForFile = - CombineCcuContentFragments m [ implFileSigType; tcState.tcsCcuSig ] - - let tcState = - { tcState with - tcsTcSigEnv = tcSigEnv - tcsTcImplEnv = tcImplEnv - tcsRootImpls = rootImpls - tcsCcuSig = ccuSigForFile - tcsCreatesGeneratedProvidedTypes = tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes - tcsImplicitOpenDeclarations = tcState.tcsImplicitOpenDeclarations @ openDecls - } - - return (tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile), tcState + let result = (tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile) + return Choice1Of2 result, tcState with e -> errorRecovery e range0 - return (tcState.TcEnvFromSignatures, EmptyTopAttrs, None, tcState.tcsCcuSig), tcState + return Choice1Of2(tcState.TcEnvFromSignatures, EmptyTopAttrs, None, tcState.tcsCcuSig), tcState } +/// Typecheck a single file (or interactive entry into F# Interactive). If skipImplIfSigExists is set to true +/// then implementations with signature files give empty results. +let CheckOneInput + ( + checkForErrors, + tcConfig: TcConfig, + tcImports: TcImports, + tcGlobals, + prefixPathOpt, + tcSink, + tcState: TcState, + input: ParsedInput, + skipImplIfSigExists: bool + ) = + cancellable { + let! partialResult, tcState = + CheckOneInputAux(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input, skipImplIfSigExists) + + match partialResult with + | Choice1Of2 result -> return result, tcState + | Choice2Of2 (amap, _conditionalDefines, rootSig, file, tcStateForImplFile, _ccuSigForFile) -> + return AddDummyCheckResultsToTcState(tcGlobals, amap, file, prefixPathOpt, tcSink, tcState, tcStateForImplFile, rootSig) + } + +// Within a file, equip loggers to locally filter w.r.t. scope pragmas in each input +let DiagnosticsLoggerForInput (tcConfig: TcConfig, input, oldLogger) = + GetDiagnosticsLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput input, tcConfig.diagnosticsOptions, oldLogger) + /// Typecheck a single file (or interactive entry into F# Interactive) -let TypeCheckOneInputEntry (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp = - // 'use' ensures that the warning handler is restored at the end - use unwindEL = - PushDiagnosticsLoggerPhaseUntilUnwind(fun oldLogger -> - GetDiagnosticsLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput inp, tcConfig.diagnosticsOptions, oldLogger)) +let CheckOneInputEntry (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, skipImplIfSigExists) tcState input = + // Equip loggers to locally filter w.r.t. scope pragmas in each input + use _ = + UseTransformedDiagnosticsLogger(fun oldLogger -> DiagnosticsLoggerForInput(tcConfig, input, oldLogger)) - use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck + use _ = UseThreadBuildPhase BuildPhase.TypeCheck RequireCompilationThread ctok - CheckOneInput(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, inp, false) + CheckOneInput(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, input, skipImplIfSigExists) |> Cancellable.runWithoutCancellation /// Finish checking multiple files (or one interactive entry into F# Interactive) @@ -1318,10 +1459,10 @@ let CheckMultipleInputsFinish (results, tcState: TcState) = let CheckOneInputAndFinish (checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) = cancellable { Logger.LogBlockStart LogCompilerFunctionId.CompileOps_TypeCheckOneInputAndFinishEventually - let! results, tcState = CheckOneInput(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input, false) - let result = CheckMultipleInputsFinish([ results ], tcState) + let! result, tcState = CheckOneInput(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input, false) + let finishedResult = CheckMultipleInputsFinish([ result ], tcState) Logger.LogBlockStop LogCompilerFunctionId.CompileOps_TypeCheckOneInputAndFinishEventually - return result + return finishedResult } let CheckClosedInputSetFinish (declaredImpls: CheckedImplFile list, tcState) = @@ -1337,11 +1478,139 @@ let CheckClosedInputSetFinish (declaredImpls: CheckedImplFile list, tcState) = tcState, declaredImpls, ccuContents -let CheckClosedInputSet (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) = +let CheckMultipleInputsSequential (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) = + (tcState, inputs) + ||> List.mapFold (CheckOneInputEntry(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, false)) + +let CheckMultipleInputsInParallel + ( + ctok, + tcConfig: TcConfig, + tcImports, + tcGlobals, + prefixPathOpt, + tcState, + exiter, + createDiagnosticsLogger, + inputs + ) = + + let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger + + // We create one CapturingDiagnosticLogger for each file we are processing and + // ensure the diagnostics are presented in deterministic order. + UseMultipleDiagnosticLoggers (inputs, exiter, diagnosticsLogger, createDiagnosticsLogger) (fun inputsWithLoggers -> + + // Equip loggers to locally filter w.r.t. scope pragmas in each input + let inputsWithLoggers = + inputsWithLoggers + |> List.map (fun (input, oldLogger) -> + let logger = DiagnosticsLoggerForInput(tcConfig, input, oldLogger) + input, logger) + + // Do the first linear phase, checking all signatures and any implementation files that don't have a signature. + // Implementation files that do have a signature will result in a Choice2Of2 indicating to next do some of the + // checking in parallel. + let partialResults, tcState = + (tcState, inputsWithLoggers) + ||> List.mapFold (fun tcState (input, logger) -> + use _ = UseDiagnosticsLogger logger + let checkForErrors () = (logger.ErrorCount > 0) + + CheckOneInputAux(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, input, true) + |> Cancellable.runWithoutCancellation) + + // Do the parallel phase, checking all implementation files that did have a signature, in parallel. + let unfinishedResults = + + List.zip partialResults inputsWithLoggers + |> List.toArray + |> ArrayParallel.map (fun (partialResult, (_, logger)) -> + use _ = UseDiagnosticsLogger logger + use _ = UseThreadBuildPhase BuildPhase.TypeCheck + + RequireCompilationThread ctok + + match partialResult with + | Choice1Of2 result -> Choice1Of2 result + | Choice2Of2 (amap, conditionalDefines, rootSig, file, tcStateForImplFile, ccuSigForFile) -> + + let checkForErrors () = (logger.ErrorCount > 0) + + let topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes = + CheckOneImplFile( + tcGlobals, + amap, + tcStateForImplFile.tcsCcu, + tcStateForImplFile.tcsImplicitOpenDeclarations, + checkForErrors, + conditionalDefines, + TcResultsSink.NoSink, + tcConfig.internalTestSpanStackReferring, + tcStateForImplFile.tcsTcImplEnv, + Some rootSig, + file + ) + |> Cancellable.runWithoutCancellation + + let result = (tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile) + Choice2Of2(result, createsGeneratedProvidedTypes)) + |> Array.toList + + let createsGeneratedProvidedTypes = + unfinishedResults + |> List.exists (function + | Choice1Of2 _ -> false + | Choice2Of2 (_, flag) -> flag) + + let tcState = + { tcState with + tcsCreatesGeneratedProvidedTypes = tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes + } + + let finishedResults = + unfinishedResults + |> List.map (function + | Choice1Of2 result -> result + | Choice2Of2 (result, _) -> result) + + finishedResults, tcState) + +let CheckClosedInputSet + ( + ctok, + checkForErrors, + tcConfig: TcConfig, + tcImports, + tcGlobals, + prefixPathOpt, + tcState, + exiter, + createDiagnosticsLogger, + inputs + ) = + + let disableParallel = + Environment.GetEnvironmentVariable("FSHARP_NO_PARALLEL_CHECKING") + |> String.IsNullOrWhiteSpace + |> not + // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions let results, tcState = - (tcState, inputs) - ||> List.mapFold (TypeCheckOneInputEntry(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) + if tcConfig.concurrentBuild && not disableParallel then + CheckMultipleInputsInParallel( + ctok, + tcConfig, + tcImports, + tcGlobals, + prefixPathOpt, + tcState, + exiter, + createDiagnosticsLogger, + inputs + ) + else + CheckMultipleInputsSequential(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _), tcState = CheckMultipleInputsFinish(results, tcState) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index b0213532030..5a8e6a64d24 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -115,7 +115,6 @@ val GetInitialTcEnv: assemblyName: string * range * TcConfig * TcImports * TcGlo /// Represents the incremental type checking state for a set of inputs [] type TcState = - member NiceNameGenerator: NiceNameGenerator /// The CcuThunk for the current assembly being checked member Ccu: CcuThunk @@ -134,20 +133,21 @@ type TcState = member CreatesGeneratedProvidedTypes: bool + member RemoveImpl: QualifiedNameOfFile -> TcState + /// Get the initial type checking state for a set of inputs -val GetInitialTcState: - range * string * TcConfig * TcGlobals * TcImports * NiceNameGenerator * TcEnv * OpenDeclaration list -> TcState +val GetInitialTcState: range * string * TcConfig * TcGlobals * TcImports * TcEnv * OpenDeclaration list -> TcState /// Check one input, returned as an Eventually computation val CheckOneInput: checkForErrors: (unit -> bool) * - TcConfig * - TcImports * - TcGlobals * - LongIdent option * - NameResolution.TcResultsSink * - TcState * - ParsedInput * + tcConfig: TcConfig * + tcImports: TcImports * + tcGlobals: TcGlobals * + prefixPathOpt: LongIdent option * + tcSink: NameResolution.TcResultsSink * + tcState: TcState * + input: ParsedInput * skipImplIfSigExists: bool -> Cancellable<(TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType) * TcState> @@ -160,14 +160,16 @@ val CheckClosedInputSetFinish: CheckedImplFile list * TcState -> TcState * Check /// Check a closed set of inputs val CheckClosedInputSet: - CompilationThreadToken * + ctok: CompilationThreadToken * checkForErrors: (unit -> bool) * - TcConfig * - TcImports * - TcGlobals * - LongIdent option * - TcState * - ParsedInput list -> + tcConfig: TcConfig * + tcImports: TcImports * + tcGlobals: TcGlobals * + prefixPathOpt: LongIdent option * + tcState: TcState * + exiter: Exiter * + createDiagnosticsLogger: (Exiter -> CapturingDiagnosticsLogger) * + inputs: ParsedInput list -> TcState * TopAttribs * CheckedImplFile list * TcEnv /// Check a single input and finish the checking diff --git a/src/Compiler/Driver/ScriptClosure.fs b/src/Compiler/Driver/ScriptClosure.fs index 868a9f80cae..9f7453a3704 100644 --- a/src/Compiler/Driver/ScriptClosure.fs +++ b/src/Compiler/Driver/ScriptClosure.fs @@ -196,7 +196,7 @@ module ScriptPreprocessClosure = match basicReferences with | None -> let diagnosticsLogger = CapturingDiagnosticsLogger("ScriptDefaultReferences") - use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) + use _ = UseDiagnosticsLogger diagnosticsLogger let references, useDotNetFramework = tcConfigB.FxResolver.GetDefaultReferences useFsiAuxLib @@ -451,7 +451,7 @@ module ScriptPreprocessClosure = if IsScript fileName || parseRequired then let parseResult, parseDiagnostics = let diagnosticsLogger = CapturingDiagnosticsLogger("FindClosureParse") - use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) + use _ = UseDiagnosticsLogger diagnosticsLogger let result = ParseScriptClosureInput(fileName, sourceText, tcConfig, codeContext, lexResourceManager, diagnosticsLogger) @@ -459,7 +459,7 @@ module ScriptPreprocessClosure = result, diagnosticsLogger.Diagnostics let diagnosticsLogger = CapturingDiagnosticsLogger("FindClosureMetaCommands") - use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) + use _ = UseDiagnosticsLogger diagnosticsLogger let pathOfMetaCommandSource = Path.GetDirectoryName fileName let preSources = tcConfig.GetAvailableLoadedSources() @@ -569,7 +569,7 @@ module ScriptPreprocessClosure = let references, unresolvedReferences, resolutionDiagnostics = let diagnosticsLogger = CapturingDiagnosticsLogger("GetLoadClosure") - use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) + use _ = UseDiagnosticsLogger diagnosticsLogger let references, unresolvedReferences = TcAssemblyResolutions.GetAssemblyResolutionInformation(tcConfig) @@ -745,7 +745,7 @@ type LoadClosure with dependencyProvider ) = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse + use _ = UseThreadBuildPhase BuildPhase.Parse ScriptPreprocessClosure.GetFullClosureOfScriptText( legacyReferenceResolver, @@ -775,5 +775,5 @@ type LoadClosure with dependencyProvider ) = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse + use _ = UseThreadBuildPhase BuildPhase.Parse ScriptPreprocessClosure.GetFullClosureOfScriptFiles(tcConfig, files, implicitDefines, lexResourceManager, dependencyProvider) diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index fcf8578d2a9..ab44e0af887 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -158,9 +158,9 @@ let TypeCheck tcConfig, tcImports, tcGlobals, + diagnosticsLoggerProvider: DiagnosticsLoggerProvider, diagnosticsLogger: DiagnosticsLogger, assemblyName, - niceNameGen, tcEnv0, openDecls0, inputs, @@ -173,16 +173,21 @@ let TypeCheck let ccuName = assemblyName let tcInitialState = - GetInitialTcState(rangeStartup, ccuName, tcConfig, tcGlobals, tcImports, niceNameGen, tcEnv0, openDecls0) + GetInitialTcState(rangeStartup, ccuName, tcConfig, tcGlobals, tcImports, tcEnv0, openDecls0) + + let createDiagnosticsLogger = + (fun exiter -> diagnosticsLoggerProvider.CreateDelayAndForwardLogger(exiter) :> CapturingDiagnosticsLogger) CheckClosedInputSet( ctok, - (fun () -> diagnosticsLogger.ErrorCount > 0), + diagnosticsLogger.CheckForErrors, tcConfig, tcImports, tcGlobals, None, tcInitialState, + exiter, + createDiagnosticsLogger, inputs ) with exn -> @@ -521,8 +526,7 @@ let main1 let delayForFlagsLogger = diagnosticsLoggerProvider.CreateDelayAndForwardLogger exiter - let _unwindEL_1 = - PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> delayForFlagsLogger) + let _holder = UseDiagnosticsLogger delayForFlagsLogger // Share intern'd strings across all lexing/parsing let lexResourceManager = Lexhelp.LexResourceManager() @@ -575,7 +579,7 @@ let main1 diagnosticsLoggerProvider.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter) // Install the global error logger and never remove it. This logger does have all command-line flags considered. - let _unwindEL_2 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) + let _holder = UseDiagnosticsLogger diagnosticsLogger // Forward all errors from flags delayForFlagsLogger.CommitDelayedDiagnostics diagnosticsLogger @@ -605,7 +609,7 @@ let main1 // Parse sourceFiles ReportTime tcConfig "Parse inputs" - use unwindParsePhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse + use unwindParsePhase = UseThreadBuildPhase BuildPhase.Parse let createDiagnosticsLogger = (fun exiter -> diagnosticsLoggerProvider.CreateDelayAndForwardLogger(exiter) :> CapturingDiagnosticsLogger) @@ -659,7 +663,7 @@ let main1 // Build the initial type checking environment ReportTime tcConfig "Typecheck" - use unwindParsePhase = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck + use unwindParsePhase = UseThreadBuildPhase BuildPhase.TypeCheck let tcEnv0, openDecls0 = GetInitialTcEnv(assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) @@ -673,9 +677,9 @@ let main1 tcConfig, tcImports, tcGlobals, + diagnosticsLoggerProvider, diagnosticsLogger, assemblyName, - NiceNameGenerator(), tcEnv0, openDecls0, inputs, @@ -782,8 +786,7 @@ let main1OfAst let delayForFlagsLogger = diagnosticsLoggerProvider.CreateDelayAndForwardLogger exiter - let _unwindEL_1 = - PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> delayForFlagsLogger) + let _holder = UseDiagnosticsLogger delayForFlagsLogger tcConfigB.conditionalDefines <- "COMPILED" :: tcConfigB.conditionalDefines @@ -805,7 +808,7 @@ let main1OfAst diagnosticsLoggerProvider.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter) // Install the global error logger and never remove it. This logger does have all command-line flags considered. - let _unwindEL_2 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) + let _holder = UseDiagnosticsLogger diagnosticsLogger // Forward all errors from flags delayForFlagsLogger.CommitDelayedDiagnostics diagnosticsLogger @@ -825,7 +828,7 @@ let main1OfAst // Register framework tcImports to be disposed in future disposables.Register frameworkTcImports - use unwindParsePhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse + use unwindParsePhase = UseThreadBuildPhase BuildPhase.Parse let meta = Directory.GetCurrentDirectory() @@ -847,7 +850,7 @@ let main1OfAst // Build the initial type checking environment ReportTime tcConfig "Typecheck" - use unwindParsePhase = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck + use unwindParsePhase = UseThreadBuildPhase BuildPhase.TypeCheck let tcEnv0, openDecls0 = GetInitialTcEnv(assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) @@ -859,9 +862,9 @@ let main1OfAst tcConfig, tcImports, tcGlobals, + diagnosticsLoggerProvider, diagnosticsLogger, assemblyName, - NiceNameGenerator(), tcEnv0, openDecls0, inputs, @@ -912,7 +915,7 @@ let main2 generatedCcu.Contents.SetAttribs(generatedCcu.Contents.Attribs @ topAttrs.assemblyAttrs) - use unwindPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.CodeGen + use unwindPhase = UseThreadBuildPhase BuildPhase.CodeGen let signingInfo = ValidateKeySigningAttributes(tcConfig, tcGlobals, topAttrs) AbortOnError(diagnosticsLogger, exiter) @@ -930,7 +933,7 @@ let main2 GetDiagnosticsLoggerFilteringByScopedPragmas(true, scopedPragmas, tcConfig.diagnosticsOptions, oldLogger) - let _unwindEL_3 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) + let _holder = UseDiagnosticsLogger diagnosticsLogger // Try to find an AssemblyVersion attribute let assemVerFromAttrib = @@ -955,7 +958,7 @@ let main2 // write interface, xmldoc ReportTime tcConfig "Write Interface File" - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Output + use _ = UseThreadBuildPhase BuildPhase.Output if tcConfig.printSignature || tcConfig.printAllSignatureFiles then InterfaceFileWriter.WriteInterfaceFile(tcGlobals, tcConfig, InfoReader(tcGlobals, tcImports.GetImportMap()), typedImplFiles) @@ -1036,7 +1039,7 @@ let main3 let optimizedImpls, optDataResources = // Perform optimization - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Optimize + use _ = UseThreadBuildPhase BuildPhase.Optimize let optEnv0 = GetInitialOptimizationEnv(tcImports, tcGlobals) @@ -1124,7 +1127,7 @@ let main4 let staticLinker = StaticLink(ctok, tcConfig, tcImports, ilGlobals) ReportTime tcConfig "TAST -> IL" - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.IlxGen + use _ = UseThreadBuildPhase BuildPhase.IlxGen // Create the Abstract IL generator let ilxGenerator = @@ -1214,7 +1217,7 @@ let main5 ilSourceDocs)) = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Output + use _ = UseThreadBuildPhase BuildPhase.Output // Static linking, if any let ilxMainModule = @@ -1248,7 +1251,7 @@ let main6 ReportTime tcConfig "Write .NET Binary" - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Output + use _ = UseThreadBuildPhase BuildPhase.Output let outfile = tcConfig.MakePathAbsolute outfile DoesNotRequireCompilerThreadTokenAndCouldPossiblyBeMadeConcurrent ctok diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 4c82c5f445a..559bfc36188 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -159,7 +159,7 @@ let rec AttachRange m (exn: exn) = | UnresolvedPathReferenceNoRange (a, p) -> UnresolvedPathReference(a, p, m) | Failure msg -> InternalError(msg + " (Failure)", m) | :? ArgumentException as exn -> InternalError(exn.Message + " (ArgumentException)", m) - | notARangeDual -> notARangeDual + | _ -> exn type Exiter = abstract Exit: int -> 'T @@ -172,9 +172,18 @@ let QuitProcessExiter = with _ -> () - FSComp.SR.elSysEnvExitDidntExit () |> failwith + failwith (FSComp.SR.elSysEnvExitDidntExit ()) } +type StopProcessingExiter() = + + member val ExitCode = 0 with get, set + + interface Exiter with + member exiter.Exit n = + exiter.ExitCode <- n + raise StopProcessing + /// Closed enumeration of build phases. [] type BuildPhase = @@ -304,6 +313,8 @@ type DiagnosticsLogger(nameForDebugging: string) = // code just below and get a breakpoint for all error logger implementations. abstract DiagnosticSink: diagnostic: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit + member x.CheckForErrors() = (x.ErrorCount > 0) + member _.DebugDisplay() = sprintf "DiagnosticsLogger(%s)" nameForDebugging @@ -476,7 +487,7 @@ module DiagnosticsLoggerExtensions = member x.ErrorRecoveryNoRange(exn: exn) = x.ErrorRecovery exn range0 /// NOTE: The change will be undone when the returned "unwind" object disposes -let PushThreadBuildPhaseUntilUnwind (phase: BuildPhase) = +let UseThreadBuildPhase (phase: BuildPhase) = let oldBuildPhase = DiagnosticsThreadStatics.BuildPhaseUnchecked DiagnosticsThreadStatics.BuildPhase <- phase @@ -486,15 +497,18 @@ let PushThreadBuildPhaseUntilUnwind (phase: BuildPhase) = } /// NOTE: The change will be undone when the returned "unwind" object disposes -let PushDiagnosticsLoggerPhaseUntilUnwind (diagnosticsLoggerTransformer: DiagnosticsLogger -> #DiagnosticsLogger) = - let oldDiagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger - DiagnosticsThreadStatics.DiagnosticsLogger <- diagnosticsLoggerTransformer oldDiagnosticsLogger +let UseTransformedDiagnosticsLogger (transformer: DiagnosticsLogger -> #DiagnosticsLogger) = + let oldLogger = DiagnosticsThreadStatics.DiagnosticsLogger + DiagnosticsThreadStatics.DiagnosticsLogger <- transformer oldLogger { new IDisposable with member _.Dispose() = - DiagnosticsThreadStatics.DiagnosticsLogger <- oldDiagnosticsLogger + DiagnosticsThreadStatics.DiagnosticsLogger <- oldLogger } +let UseDiagnosticsLogger newLogger = + UseTransformedDiagnosticsLogger (fun _ -> newLogger) + let SetThreadBuildPhaseNoUnwind (phase: BuildPhase) = DiagnosticsThreadStatics.BuildPhase <- phase @@ -505,8 +519,8 @@ let SetThreadDiagnosticsLoggerNoUnwind diagnosticsLogger = /// /// Use to reset error and warning handlers. type CompilationGlobalsScope(diagnosticsLogger: DiagnosticsLogger, buildPhase: BuildPhase) = - let unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) - let unwindBP = PushThreadBuildPhaseUntilUnwind buildPhase + let unwindEL = UseDiagnosticsLogger diagnosticsLogger + let unwindBP = UseThreadBuildPhase buildPhase member _.DiagnosticsLogger = diagnosticsLogger member _.BuildPhase = buildPhase diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index c3af3a7da9d..cdc8f938598 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -85,11 +85,21 @@ val inline protectAssemblyExplorationNoReraise: dflt1: 'T -> dflt2: 'T -> f: (un val AttachRange: m: range -> exn: exn -> exn +/// Represnts an early exit from parsing, checking etc, for example because 'maxerrors' has been reached. type Exiter = - abstract member Exit: int -> 'T + abstract Exit: int -> 'T +/// An exiter that quits the process if Exit is called. val QuitProcessExiter: Exiter +/// An exiter that raises StopProcessingException if Exit is called, saving the exit code in ExitCode. +type StopProcessingExiter = + interface Exiter + + new: unit -> StopProcessingExiter + + member ExitCode: int with get, set + /// Closed enumeration of build phases. [] type BuildPhase = @@ -166,6 +176,7 @@ type PhasedDiagnostic = /// member Subcategory: unit -> string +/// Represents a capability to log diagnostics [] type DiagnosticsLogger = @@ -173,14 +184,22 @@ type DiagnosticsLogger = member DebugDisplay: unit -> string - abstract member DiagnosticSink: diagnostic: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit + /// Emit a diagnostic to the logger + abstract DiagnosticSink: diagnostic: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit - abstract member ErrorCount: int + /// Get the number of error diagnostics reported + abstract ErrorCount: int + /// Checks if ErrorCount > 0 + member CheckForErrors: unit -> bool + +/// Represents a DiagnosticsLogger that discards diagnostics val DiscardErrorsLogger: DiagnosticsLogger +/// Represents a DiagnosticsLogger that ignores diagnostics and asserts val AssertFalseDiagnosticsLogger: DiagnosticsLogger +/// Represents a DiagnosticsLogger that captures all diagnostics type CapturingDiagnosticsLogger = inherit DiagnosticsLogger @@ -194,6 +213,7 @@ type CapturingDiagnosticsLogger = override ErrorCount: int +/// Thread statics for the installed diagnostic logger [] type DiagnosticsThreadStatics = @@ -216,26 +236,41 @@ module DiagnosticsLoggerExtensions = type DiagnosticsLogger with + /// Report a diagnostic as an error and recover member ErrorR: exn: exn -> unit + /// Report a diagnostic as a warning and recover member Warning: exn: exn -> unit + /// Report a diagnostic as an error and raise `ReportedError` member Error: exn: exn -> 'T + /// Simulates a diagnostic. For test purposes only. member SimulateError: diagnostic: PhasedDiagnostic -> 'T + /// Perform error recovery from an exception if possible. + /// - StopProcessingExn is not caught. + /// - ReportedError is caught and ignored. + /// - TargetInvocationException is unwrapped + /// - If precisely a System.Exception or ArgumentException then the range is attached as InternalError. + /// - Other exceptions are unchanged + /// + /// All are reported via the installed diagnostics logger member ErrorRecovery: exn: exn -> m: range -> unit + /// Perform error recovery from an exception if possible, including catching StopProcessingExn member StopProcessingRecovery: exn: exn -> m: range -> unit + /// Like ErrorRecover by no range is attached to System.Exception and ArgumentException. member ErrorRecoveryNoRange: exn: exn -> unit /// NOTE: The change will be undone when the returned "unwind" object disposes -val PushThreadBuildPhaseUntilUnwind: phase: BuildPhase -> IDisposable +val UseThreadBuildPhase: phase: BuildPhase -> IDisposable /// NOTE: The change will be undone when the returned "unwind" object disposes -val PushDiagnosticsLoggerPhaseUntilUnwind: - diagnosticsLoggerTransformer: (DiagnosticsLogger -> #DiagnosticsLogger) -> IDisposable +val UseTransformedDiagnosticsLogger: transformer: (DiagnosticsLogger -> #DiagnosticsLogger) -> IDisposable + +val UseDiagnosticsLogger: newLogger: DiagnosticsLogger -> IDisposable val SetThreadBuildPhaseNoUnwind: phase: BuildPhase -> unit diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 316dfd429bb..5f339642dc7 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -800,7 +800,7 @@ type internal DiagnosticsLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, override x.ErrorCount = errorCount type DiagnosticsLogger with - member x.CheckForErrors() = (x.ErrorCount > 0) + /// A helper function to check if its time to abort member x.AbortOnError(fsiConsoleOutput:FsiConsoleOutput) = if x.ErrorCount > 0 then @@ -1331,7 +1331,6 @@ type internal FsiDynamicCompiler( fsiOptions : FsiCommandLineOptions, fsiConsoleOutput : FsiConsoleOutput, fsiCollectible: bool, - niceNameGen, resolveAssemblyRef ) = @@ -1676,7 +1675,19 @@ 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, topCustomAttrs, declaredImpls, tcEnvAtEndOfLastInput = - lock tcLockObject (fun _ -> CheckClosedInputSet(ctok, diagnosticsLogger.CheckForErrors, tcConfig, tcImports, tcGlobals, Some prefixPath, tcState, inputs)) + lock tcLockObject (fun _ -> + CheckClosedInputSet( + ctok, + diagnosticsLogger.CheckForErrors, + tcConfig, + tcImports, + tcGlobals, + Some prefixPath, + tcState, + StopProcessingExiter(), + (fun _ -> CapturingDiagnosticsLogger("FsiProcessInputsLogger")), + inputs) + ) let codegenResults, optEnv, fragName = ProcessTypedImpl(diagnosticsLogger, optEnv, tcState, tcConfig, isInteractiveItExpr, topCustomAttrs, prefixPath, isIncrementalFragment, declaredImpls, ilxGenerator) @@ -2156,7 +2167,7 @@ type internal FsiDynamicCompiler( let tcEnv, openDecls0 = GetInitialTcEnv (dynamicCcuName, rangeStdin0, tcConfig, tcImports, tcGlobals) let ccuName = dynamicCcuName - let tcState = GetInitialTcState (rangeStdin0, ccuName, tcConfig, tcGlobals, tcImports, niceNameGen, tcEnv, openDecls0) + let tcState = GetInitialTcState (rangeStdin0, ccuName, tcConfig, tcGlobals, tcImports, tcEnv, openDecls0) let ilxGenerator = CreateIlxAssemblyGenerator (tcConfig, tcImports, tcGlobals, (LightweightTcValForUsingInBuildMethodCall tcGlobals), tcState.Ccu) @@ -3038,8 +3049,8 @@ type FsiInteractionProcessor member _.EvalInteraction(ctok, sourceText, scriptFileName, diagnosticsLogger, ?cancellationToken) = let cancellationToken = defaultArg cancellationToken CancellationToken.None - use _unwind1 = PushThreadBuildPhaseUntilUnwind(BuildPhase.Interactive) - use _unwind2 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) + use _ = UseThreadBuildPhase BuildPhase.Interactive + use _ = UseDiagnosticsLogger diagnosticsLogger use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID let lexbuf = UnicodeLexing.StringAsLexbuf(true, tcConfigB.langVersion, sourceText) let tokenizer = fsiStdinLexerProvider.CreateBufferLexer(scriptFileName, lexbuf, diagnosticsLogger) @@ -3055,8 +3066,8 @@ type FsiInteractionProcessor this.EvalInteraction (ctok, sourceText, scriptPath, diagnosticsLogger) member _.EvalExpression (ctok, sourceText, scriptFileName, diagnosticsLogger) = - use _unwind1 = PushThreadBuildPhaseUntilUnwind(BuildPhase.Interactive) - use _unwind2 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) + use _unwind1 = UseThreadBuildPhase BuildPhase.Interactive + use _unwind2 = UseDiagnosticsLogger diagnosticsLogger use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID let lexbuf = UnicodeLexing.StringAsLexbuf(true, tcConfigB.langVersion, sourceText) let tokenizer = fsiStdinLexerProvider.CreateBufferLexer(scriptFileName, lexbuf, diagnosticsLogger) @@ -3361,8 +3372,6 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i with e -> stopProcessingRecovery e range0; failwithf "Error creating evaluation session: %A" e - let niceNameGen = NiceNameGenerator() - // Share intern'd strings across all lexing/parsing let lexResourceManager = LexResourceManager() @@ -3382,7 +3391,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i | Some resolvedPath -> Some (Choice1Of2 resolvedPath) | None -> None - let fsiDynamicCompiler = FsiDynamicCompiler(fsi, timeReporter, tcConfigB, tcLockObject, outWriter, tcImports, tcGlobals, fsiOptions, fsiConsoleOutput, fsiCollectible, niceNameGen, resolveAssemblyRef) + let fsiDynamicCompiler = FsiDynamicCompiler(fsi, timeReporter, tcConfigB, tcLockObject, outWriter, tcImports, tcGlobals, fsiOptions, fsiConsoleOutput, fsiCollectible, resolveAssemblyRef) let controlledExecution = ControlledExecution() @@ -3636,7 +3645,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i if fsiOptions.IsInteractiveServer then SpawnInteractiveServer (fsi, fsiOptions, fsiConsoleOutput) - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Interactive + use _ = UseThreadBuildPhase BuildPhase.Interactive if fsiOptions.Interact then // page in the type check env diff --git a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs index 26b43155830..a75900b1c26 100644 --- a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs +++ b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs @@ -96,10 +96,7 @@ type internal InProcCompiler(legacyReferenceResolver) = let ctok = AssumeCompilationThreadWithoutEvidence () let loggerProvider = InProcDiagnosticsLoggerProvider() - let mutable exitCode = 0 - let exiter = - { new Exiter with - member _.Exit n = exitCode <- n; raise StopProcessing } + let exiter = StopProcessingExiter() try CompileFromCommandLineArguments ( ctok, argv, legacyReferenceResolver, @@ -111,14 +108,14 @@ type internal InProcCompiler(legacyReferenceResolver) = | StopProcessing -> () | ReportedError _ | WrappedError(ReportedError _,_) -> - exitCode <- 1 + exiter.ExitCode <- 1 () let output: CompilationOutput = { Warnings = loggerProvider.CapturedWarnings Errors = loggerProvider.CapturedErrors } - exitCode = 0, output + (exiter.ExitCode = 0), output /// in-proc version of fsc.exe type internal FscCompiler(legacyReferenceResolver) = diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index b01819fc2b7..82cabdc24f9 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -2127,8 +2127,8 @@ type FSharpParsingOptions = module internal ParseAndCheckFile = - /// Error handler for parsing & type checking while processing a single file - type ErrorHandler + /// Diagnostics handler for parsing & type checking while processing a single file + type DiagnosticsHandler ( reportErrors, mainInputFileName, @@ -2180,7 +2180,7 @@ module internal ParseAndCheckFile = | _ -> collectOne severity diagnostic let diagnosticsLogger = - { new DiagnosticsLogger("ErrorHandler") with + { new DiagnosticsLogger("DiagnosticsHandler") with member _.DiagnosticSink(exn, severity) = diagnosticSink severity exn member _.ErrorCount = errorCount } @@ -2209,7 +2209,7 @@ module internal ParseAndCheckFile = IndentationAwareSyntaxStatus(indentationSyntaxStatus, true) - let createLexerFunction fileName options lexbuf (errHandler: ErrorHandler) = + let createLexerFunction fileName options lexbuf (errHandler: DiagnosticsHandler) = let indentationSyntaxStatus = getLightSyntaxStatus fileName options // If we're editing a script then we define INTERACTIVE otherwise COMPILED. @@ -2243,22 +2243,18 @@ module internal ParseAndCheckFile = UnicodeLexing.SourceTextAsLexbuf(true, LanguageVersion(langVersion), sourceText) let matchBraces (sourceText: ISourceText, fileName, options: FSharpParsingOptions, userOpName: string, suggestNamesForErrors: bool) = + // Make sure there is an DiagnosticsLogger installed whenever we do stuff that might record errors, even if we ultimately ignore the errors let delayedLogger = CapturingDiagnosticsLogger("matchBraces") - use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> delayedLogger) - use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse + use _ = UseDiagnosticsLogger delayedLogger + use _ = UseThreadBuildPhase BuildPhase.Parse Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "matchBraces", fileName) - // Make sure there is an DiagnosticsLogger installed whenever we do stuff that might record errors, even if we ultimately ignore the errors - let delayedLogger = CapturingDiagnosticsLogger("matchBraces") - use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> delayedLogger) - use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - let matchingBraces = ResizeArray<_>() usingLexbufForParsing (createLexbuf options.LangVersionText sourceText, fileName) (fun lexbuf -> let errHandler = - ErrorHandler(false, fileName, options.DiagnosticOptions, sourceText, suggestNamesForErrors) + DiagnosticsHandler(false, fileName, options.DiagnosticOptions, sourceText, suggestNamesForErrors) let lexfun = createLexerFunction fileName options lexbuf errHandler @@ -2349,12 +2345,11 @@ module internal ParseAndCheckFile = Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "parseFile", fileName) let errHandler = - ErrorHandler(true, fileName, options.DiagnosticOptions, sourceText, suggestNamesForErrors) + DiagnosticsHandler(true, fileName, options.DiagnosticOptions, sourceText, suggestNamesForErrors) - use unwindEL = - PushDiagnosticsLoggerPhaseUntilUnwind(fun _oldLogger -> errHandler.DiagnosticsLogger) + use _ = UseDiagnosticsLogger errHandler.DiagnosticsLogger - use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse + use _ = UseThreadBuildPhase BuildPhase.Parse let parseResult = usingLexbufForParsing (createLexbuf options.LangVersionText sourceText, fileName) (fun lexbuf -> @@ -2509,12 +2504,11 @@ module internal ParseAndCheckFile = // Initialize the error handler let errHandler = - ErrorHandler(true, mainInputFileName, tcConfig.diagnosticsOptions, sourceText, suggestNamesForErrors) + DiagnosticsHandler(true, mainInputFileName, tcConfig.diagnosticsOptions, sourceText, suggestNamesForErrors) - use _unwindEL = - PushDiagnosticsLoggerPhaseUntilUnwind(fun _oldLogger -> errHandler.DiagnosticsLogger) + use _ = UseDiagnosticsLogger errHandler.DiagnosticsLogger - use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck + use _unwindBP = UseThreadBuildPhase BuildPhase.TypeCheck // Apply nowarns to tcConfig (may generate errors, so ensure diagnosticsLogger is installed) let tcConfig = @@ -2531,11 +2525,6 @@ module internal ParseAndCheckFile = // If additional references were brought in by the preprocessor then we need to process them ApplyLoadClosure(tcConfig, parsedMainInput, mainInputFileName, loadClosure, tcImports, backgroundDiagnostics) - // A problem arises with nice name generation, which really should only - // be done in the backend, but is also done in the typechecker for better or worse. - // If we don't do this the NNG accumulates data and we get a memory leak. - tcState.NiceNameGenerator.Reset() - // Typecheck the real input. let sink = TcResultsSinkImpl(tcGlobals, sourceText = sourceText) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 45e50d441bf..a1f5d0b0559 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -745,7 +745,6 @@ module IncrementalBuilderHelpers = unresolvedReferences, dependencyProvider, loadClosureOpt: LoadClosure option, - niceNameGen, basicDependencies, keepAssemblyContents, keepAllBackgroundResolutions, @@ -794,7 +793,7 @@ module IncrementalBuilderHelpers = } let tcInitial, openDecls0 = GetInitialTcEnv (assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) - let tcState = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, niceNameGen, tcInitial, openDecls0) + let tcState = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, tcInitial, openDecls0) let loadClosureErrors = [ match loadClosureOpt with | None -> () @@ -1541,7 +1540,6 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc setupConfigFromLoadClosure() let tcConfig = TcConfig.Create(tcConfigB, validate=true) - let niceNameGen = NiceNameGenerator() let outfile, _, assemblyName = tcConfigB.DecideNames sourceFiles // Resolve assemblies and create the framework TcImports. This is done when constructing the @@ -1625,7 +1623,6 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc unresolvedReferences, dependencyProvider, loadClosureOpt, - niceNameGen, basicDependencies, keepAssemblyContents, keepAllBackgroundResolutions, diff --git a/src/Compiler/Service/ServiceLexing.fs b/src/Compiler/Service/ServiceLexing.fs index 884afb3901a..54e3a26f24d 100644 --- a/src/Compiler/Service/ServiceLexing.fs +++ b/src/Compiler/Service/ServiceLexing.fs @@ -1049,8 +1049,8 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, maxLength: int option, fi // Scan a token starting with the given lexer state member x.ScanToken(lexState: FSharpTokenizerLexState) : FSharpTokenInfo option * FSharpTokenizerLexState = - use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> DiscardErrorsLogger) + use _ = UseThreadBuildPhase BuildPhase.Parse + use _ = UseDiagnosticsLogger DiscardErrorsLogger let indentationSyntaxStatus, lexcont = LexerStateEncoding.decodeLexInt lexState @@ -1835,8 +1835,8 @@ module FSharpLexerImpl = else lexer - use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> DiscardErrorsLogger) + use _ = UseThreadBuildPhase BuildPhase.Parse + use _ = UseDiagnosticsLogger DiscardErrorsLogger resetLexbufPos "" lexbuf diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index e58b5be8261..88f001e20a2 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -113,13 +113,10 @@ module CompileHelpers = diagnostics, diagnosticsLogger, loggerProvider let tryCompile diagnosticsLogger f = - use unwindParsePhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - use unwindEL_2 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) + use _ = UseThreadBuildPhase BuildPhase.Parse + use _ = UseDiagnosticsLogger diagnosticsLogger - let exiter = - { new Exiter with - member x.Exit n = raise StopProcessing - } + let exiter = StopProcessingExiter() try f exiter diff --git a/src/Compiler/Symbols/FSharpDiagnostic.fs b/src/Compiler/Symbols/FSharpDiagnostic.fs index a99f02dbc44..8e886c21b2b 100644 --- a/src/Compiler/Symbols/FSharpDiagnostic.fs +++ b/src/Compiler/Symbols/FSharpDiagnostic.fs @@ -104,16 +104,16 @@ type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: str [] type DiagnosticsScope() = let mutable diags = [] - let unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck + let unwindBP = UseThreadBuildPhase BuildPhase.TypeCheck let unwindEL = - PushDiagnosticsLoggerPhaseUntilUnwind (fun _oldLogger -> + UseDiagnosticsLogger { new DiagnosticsLogger("DiagnosticsScope") with member _.DiagnosticSink(diagnostic, severity) = let diagnostic = FSharpDiagnostic.CreateFromException(diagnostic, severity, range.Zero, false) diags <- diagnostic :: diags - member _.ErrorCount = diags.Length }) + member _.ErrorCount = diags.Length } member _.Errors = diags |> List.filter (fun error -> error.Severity = FSharpDiagnosticSeverity.Error) @@ -126,7 +126,7 @@ type DiagnosticsScope() = interface IDisposable with member _.Dispose() = - unwindEL.Dispose() (* unwind pushes when DiagnosticsScope disposes *) + unwindEL.Dispose() unwindBP.Dispose() /// Used at entry points to FSharp.Compiler.Service (service.fsi) which manipulate symbols and diff --git a/src/Compiler/SyntaxTree/LexHelpers.fs b/src/Compiler/SyntaxTree/LexHelpers.fs index 80fc0c21246..ae8b9deb615 100644 --- a/src/Compiler/SyntaxTree/LexHelpers.fs +++ b/src/Compiler/SyntaxTree/LexHelpers.fs @@ -97,7 +97,7 @@ let mkLexargs /// Register the lexbuf and call the given function let reusingLexbufForParsing lexbuf f = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse + use _ = UseThreadBuildPhase BuildPhase.Parse LexbufLocalXmlDocStore.ClearXmlDoc lexbuf LexbufCommentStore.ClearComments lexbuf diff --git a/src/Compiler/TypedTree/CompilerGlobalState.fs b/src/Compiler/TypedTree/CompilerGlobalState.fs index e419be25d00..b7eea4fb718 100644 --- a/src/Compiler/TypedTree/CompilerGlobalState.fs +++ b/src/Compiler/TypedTree/CompilerGlobalState.fs @@ -20,7 +20,7 @@ type NiceNameGenerator() = let lockObj = obj() let basicNameCounts = Dictionary(100) - member x.FreshCompilerGeneratedName (name, m: range) = + member _.FreshCompilerGeneratedName (name, m: range) = lock lockObj (fun () -> let basicName = GetBasicNameOfPossibleCompilerGeneratedName name let n = @@ -31,7 +31,7 @@ type NiceNameGenerator() = basicNameCounts[basicName] <- n + 1 nm) - member x.Reset () = + member _.Reset () = lock lockObj (fun () -> basicNameCounts.Clear() ) diff --git a/src/Compiler/Utilities/lib.fs b/src/Compiler/Utilities/lib.fs index b0e75623531..1dc1429d408 100755 --- a/src/Compiler/Utilities/lib.fs +++ b/src/Compiler/Utilities/lib.fs @@ -608,4 +608,14 @@ module ArrayParallel = let inline map f (arr: 'T []) = arr |> mapi (fun _ item -> f item) + +[] +module ListParallel = + + let map f (xs: 'T list) = + xs + |> List.toArray + |> ArrayParallel.map f + |> Array.toList + \ No newline at end of file diff --git a/src/Compiler/Utilities/lib.fsi b/src/Compiler/Utilities/lib.fsi index 585d4a5911f..fa482500064 100644 --- a/src/Compiler/Utilities/lib.fsi +++ b/src/Compiler/Utilities/lib.fsi @@ -315,6 +315,21 @@ type DisposablesTracker = [] module ArrayParallel = + val inline iter: ('T -> unit) -> 'T[] -> unit + + val inline iteri: (int -> 'T -> unit) -> 'T[] -> unit + val inline map: ('T -> 'U) -> 'T[] -> 'U[] val inline mapi: (int -> 'T -> 'U) -> 'T[] -> 'U[] + +[] +module ListParallel = + + //val inline iter: ('T -> unit) -> 'T list -> unit + + //val inline iteri: (int -> 'T -> unit) -> 'T list -> unit + + val map: ('T -> 'U) -> 'T list -> 'U list + +//val inline mapi: (int -> 'T -> 'U) -> 'T list -> 'U list diff --git a/src/fsc/fscmain.fs b/src/fsc/fscmain.fs index 9fc65db7cdc..d5a0572a66b 100644 --- a/src/fsc/fscmain.fs +++ b/src/fsc/fscmain.fs @@ -37,7 +37,7 @@ let main (argv) = Thread.CurrentThread.Name <- "F# Main Thread" // Set the initial phase to garbage collector to batch mode, which improves overall performance. - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter + use _ = UseThreadBuildPhase BuildPhase.Parameter // An SDL recommendation UnmanagedProcessExecutionOptions.EnableHeapTerminationOnCorruption() From 6e9a0854c03c3953196325a71a9752495e54d205 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 23 Aug 2022 02:58:09 +0100 Subject: [PATCH 02/33] simplify names --- src/Compiler/CodeGen/IlxGen.fs | 2 +- src/Compiler/Driver/CompilerConfig.fs | 14 ++++++------- src/Compiler/Driver/CompilerImports.fs | 8 ++++---- src/Compiler/Driver/CompilerOptions.fs | 2 +- src/Compiler/Driver/ParseAndCheckInputs.fs | 10 +++++----- src/Compiler/Driver/ScriptClosure.fs | 4 ++-- src/Compiler/Driver/fsc.fs | 20 +++++++++---------- src/Compiler/Facilities/DiagnosticsLogger.fs | 4 ++-- src/Compiler/Facilities/DiagnosticsLogger.fsi | 2 +- src/Compiler/Interactive/fsi.fs | 6 +++--- src/Compiler/Service/FSharpCheckerResults.fs | 6 +++--- src/Compiler/Service/ServiceLexing.fs | 4 ++-- src/Compiler/Service/service.fs | 2 +- src/Compiler/Symbols/FSharpDiagnostic.fs | 2 +- src/Compiler/SyntaxTree/LexHelpers.fs | 2 +- src/fsc/fscmain.fs | 2 +- 16 files changed, 45 insertions(+), 45 deletions(-) diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 796979490e0..829b7e03d20 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -11631,7 +11631,7 @@ type IlxGenResults = let GenerateCode (cenv, anonTypeTable, eenv, CheckedAssemblyAfterOptimization implFiles, assemAttribs, moduleAttribs) = - use _ = UseThreadBuildPhase BuildPhase.IlxGen + use _ = UseBuildPhase BuildPhase.IlxGen let g = cenv.g // Generate the implementations into the mgbuf diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs index 2bac1b37d97..753288833ac 100644 --- a/src/Compiler/Driver/CompilerConfig.fs +++ b/src/Compiler/Driver/CompilerConfig.fs @@ -797,7 +797,7 @@ type TcConfigBuilder = tcConfigB.fxResolver <- None // this needs to be recreated when the primary assembly changes member tcConfigB.ResolveSourceFile(m, nm, pathLoadedFrom) = - use _ = UseThreadBuildPhase BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter let paths = seq { @@ -809,7 +809,7 @@ type TcConfigBuilder = /// Decide names of output file, pdb and assembly member tcConfigB.DecideNames sourceFiles = - use _ = UseThreadBuildPhase BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter if sourceFiles = [] then errorR (Error(FSComp.SR.buildNoInputsSpecified (), rangeCmdArgs)) @@ -860,7 +860,7 @@ type TcConfigBuilder = outfile, pdbfile, assemblyName member tcConfigB.TurnWarningOff(m, s: string) = - use _ = UseThreadBuildPhase BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter match GetWarningNumber(m, s) with | None -> () @@ -875,7 +875,7 @@ type TcConfigBuilder = } member tcConfigB.TurnWarningOn(m, s: string) = - use _ = UseThreadBuildPhase BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter match GetWarningNumber(m, s) with | None -> () @@ -1309,7 +1309,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member _.exiter = data.exiter static member Create(builder, validate) = - use _ = UseThreadBuildPhase BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter TcConfig(builder, validate) member _.legacyReferenceResolver = data.legacyReferenceResolver @@ -1326,7 +1326,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member _.GetTargetFrameworkDirectories() = targetFrameworkDirectories member tcConfig.ComputeIndentationAwareSyntaxInitialStatus fileName = - use _unwindBuildPhase = UseThreadBuildPhase BuildPhase.Parameter + use _unwindBuildPhase = UseBuildPhase BuildPhase.Parameter let indentationAwareSyntaxOnByDefault = List.exists (FileSystemUtils.checkSuffix fileName) FSharpIndentationAwareSyntaxFileSuffixes @@ -1337,7 +1337,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = (tcConfig.indentationAwareSyntax = Some true) member tcConfig.GetAvailableLoadedSources() = - use _unwindBuildPhase = UseThreadBuildPhase BuildPhase.Parameter + use _unwindBuildPhase = UseBuildPhase BuildPhase.Parameter let resolveLoadedSource (m, originalPath, path) = try diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index bbac0d200f6..538ccd0817b 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -382,7 +382,7 @@ type TcConfig with member tcConfig.TryResolveLibWithDirectories(r: AssemblyReference) = let m, nm = r.Range, r.Text - use _ = UseThreadBuildPhase BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter // See if the language service has already produced the contents of the assembly for us, virtually match r.ProjectReference with @@ -436,7 +436,7 @@ type TcConfig with member tcConfig.ResolveLibWithDirectories(ccuLoadFailureAction, r: AssemblyReference) = let m, nm = r.Range, r.Text - use _ = UseThreadBuildPhase BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter let rs = if IsExe nm || IsDLL nm || IsNetModule nm then @@ -504,7 +504,7 @@ type TcConfig with mode: ResolveAssemblyReferenceMode ) : AssemblyResolution list * UnresolvedAssemblyReference list = - use _ = UseThreadBuildPhase BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter if tcConfig.useSimpleResolution then failwith "MSBuild resolution is not supported." @@ -801,7 +801,7 @@ type TcAssemblyResolutions(tcConfig: TcConfig, results: AssemblyResolution list, TcAssemblyResolutions.ResolveAssemblyReferences(tcConfig, references, knownUnresolved) static member GetAssemblyResolutionInformation(tcConfig: TcConfig) = - use _ = UseThreadBuildPhase BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter let assemblyList = TcAssemblyResolutions.GetAllDllReferences tcConfig let resolutions = diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index a8db6f6d6db..ca6119460e5 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -257,7 +257,7 @@ module ResponseFile = Choice2Of2 e let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: CompilerOptionBlock list, args) = - use _ = UseThreadBuildPhase BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter let specs = List.collect GetOptionsOfBlock blocks diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 840e7a0d665..2d10b532a6a 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -427,7 +427,7 @@ let ParseInput // #nowarn declarations for the file let delayLogger = CapturingDiagnosticsLogger("Parsing") use _ = UseDiagnosticsLogger delayLogger - use _ = UseThreadBuildPhase BuildPhase.Parse + use _ = UseBuildPhase BuildPhase.Parse let mutable scopedPragmas = [] @@ -550,7 +550,7 @@ let EmptyParsedInput (fileName, isLastCompiland) = /// Parse an input, drawing tokens from the LexBuffer let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, lexbuf, fileName, isLastCompiland, diagnosticsLogger) = - use unwindbuildphase = UseThreadBuildPhase BuildPhase.Parse + use unwindbuildphase = UseBuildPhase BuildPhase.Parse try @@ -877,7 +877,7 @@ let ProcessMetaCommandsFromInput (tcConfig: TcConfigBuilder, inp: ParsedInput, pathOfMetaCommandSource, state0) = - use _ = UseThreadBuildPhase BuildPhase.Parse + use _ = UseBuildPhase BuildPhase.Parse let canHaveScriptMetaCommands = match inp with @@ -1436,7 +1436,7 @@ let CheckOneInputEntry (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcG use _ = UseTransformedDiagnosticsLogger(fun oldLogger -> DiagnosticsLoggerForInput(tcConfig, input, oldLogger)) - use _ = UseThreadBuildPhase BuildPhase.TypeCheck + use _ = UseBuildPhase BuildPhase.TypeCheck RequireCompilationThread ctok @@ -1527,7 +1527,7 @@ let CheckMultipleInputsInParallel |> List.toArray |> ArrayParallel.map (fun (partialResult, (_, logger)) -> use _ = UseDiagnosticsLogger logger - use _ = UseThreadBuildPhase BuildPhase.TypeCheck + use _ = UseBuildPhase BuildPhase.TypeCheck RequireCompilationThread ctok diff --git a/src/Compiler/Driver/ScriptClosure.fs b/src/Compiler/Driver/ScriptClosure.fs index 9f7453a3704..45c7aa5a0f5 100644 --- a/src/Compiler/Driver/ScriptClosure.fs +++ b/src/Compiler/Driver/ScriptClosure.fs @@ -745,7 +745,7 @@ type LoadClosure with dependencyProvider ) = - use _ = UseThreadBuildPhase BuildPhase.Parse + use _ = UseBuildPhase BuildPhase.Parse ScriptPreprocessClosure.GetFullClosureOfScriptText( legacyReferenceResolver, @@ -775,5 +775,5 @@ type LoadClosure with dependencyProvider ) = - use _ = UseThreadBuildPhase BuildPhase.Parse + use _ = UseBuildPhase BuildPhase.Parse ScriptPreprocessClosure.GetFullClosureOfScriptFiles(tcConfig, files, implicitDefines, lexResourceManager, dependencyProvider) diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index ab44e0af887..a1be81257c5 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -609,7 +609,7 @@ let main1 // Parse sourceFiles ReportTime tcConfig "Parse inputs" - use unwindParsePhase = UseThreadBuildPhase BuildPhase.Parse + use unwindParsePhase = UseBuildPhase BuildPhase.Parse let createDiagnosticsLogger = (fun exiter -> diagnosticsLoggerProvider.CreateDelayAndForwardLogger(exiter) :> CapturingDiagnosticsLogger) @@ -663,7 +663,7 @@ let main1 // Build the initial type checking environment ReportTime tcConfig "Typecheck" - use unwindParsePhase = UseThreadBuildPhase BuildPhase.TypeCheck + use unwindParsePhase = UseBuildPhase BuildPhase.TypeCheck let tcEnv0, openDecls0 = GetInitialTcEnv(assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) @@ -828,7 +828,7 @@ let main1OfAst // Register framework tcImports to be disposed in future disposables.Register frameworkTcImports - use unwindParsePhase = UseThreadBuildPhase BuildPhase.Parse + use unwindParsePhase = UseBuildPhase BuildPhase.Parse let meta = Directory.GetCurrentDirectory() @@ -850,7 +850,7 @@ let main1OfAst // Build the initial type checking environment ReportTime tcConfig "Typecheck" - use unwindParsePhase = UseThreadBuildPhase BuildPhase.TypeCheck + use unwindParsePhase = UseBuildPhase BuildPhase.TypeCheck let tcEnv0, openDecls0 = GetInitialTcEnv(assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) @@ -915,7 +915,7 @@ let main2 generatedCcu.Contents.SetAttribs(generatedCcu.Contents.Attribs @ topAttrs.assemblyAttrs) - use unwindPhase = UseThreadBuildPhase BuildPhase.CodeGen + use unwindPhase = UseBuildPhase BuildPhase.CodeGen let signingInfo = ValidateKeySigningAttributes(tcConfig, tcGlobals, topAttrs) AbortOnError(diagnosticsLogger, exiter) @@ -958,7 +958,7 @@ let main2 // write interface, xmldoc ReportTime tcConfig "Write Interface File" - use _ = UseThreadBuildPhase BuildPhase.Output + use _ = UseBuildPhase BuildPhase.Output if tcConfig.printSignature || tcConfig.printAllSignatureFiles then InterfaceFileWriter.WriteInterfaceFile(tcGlobals, tcConfig, InfoReader(tcGlobals, tcImports.GetImportMap()), typedImplFiles) @@ -1039,7 +1039,7 @@ let main3 let optimizedImpls, optDataResources = // Perform optimization - use _ = UseThreadBuildPhase BuildPhase.Optimize + use _ = UseBuildPhase BuildPhase.Optimize let optEnv0 = GetInitialOptimizationEnv(tcImports, tcGlobals) @@ -1127,7 +1127,7 @@ let main4 let staticLinker = StaticLink(ctok, tcConfig, tcImports, ilGlobals) ReportTime tcConfig "TAST -> IL" - use _ = UseThreadBuildPhase BuildPhase.IlxGen + use _ = UseBuildPhase BuildPhase.IlxGen // Create the Abstract IL generator let ilxGenerator = @@ -1217,7 +1217,7 @@ let main5 ilSourceDocs)) = - use _ = UseThreadBuildPhase BuildPhase.Output + use _ = UseBuildPhase BuildPhase.Output // Static linking, if any let ilxMainModule = @@ -1251,7 +1251,7 @@ let main6 ReportTime tcConfig "Write .NET Binary" - use _ = UseThreadBuildPhase BuildPhase.Output + use _ = UseBuildPhase BuildPhase.Output let outfile = tcConfig.MakePathAbsolute outfile DoesNotRequireCompilerThreadTokenAndCouldPossiblyBeMadeConcurrent ctok diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 559bfc36188..f384a477a7c 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -487,7 +487,7 @@ module DiagnosticsLoggerExtensions = member x.ErrorRecoveryNoRange(exn: exn) = x.ErrorRecovery exn range0 /// NOTE: The change will be undone when the returned "unwind" object disposes -let UseThreadBuildPhase (phase: BuildPhase) = +let UseBuildPhase (phase: BuildPhase) = let oldBuildPhase = DiagnosticsThreadStatics.BuildPhaseUnchecked DiagnosticsThreadStatics.BuildPhase <- phase @@ -520,7 +520,7 @@ let SetThreadDiagnosticsLoggerNoUnwind diagnosticsLogger = /// Use to reset error and warning handlers. type CompilationGlobalsScope(diagnosticsLogger: DiagnosticsLogger, buildPhase: BuildPhase) = let unwindEL = UseDiagnosticsLogger diagnosticsLogger - let unwindBP = UseThreadBuildPhase buildPhase + let unwindBP = UseBuildPhase buildPhase member _.DiagnosticsLogger = diagnosticsLogger member _.BuildPhase = buildPhase diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index cdc8f938598..0736d00f917 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -265,7 +265,7 @@ module DiagnosticsLoggerExtensions = member ErrorRecoveryNoRange: exn: exn -> unit /// NOTE: The change will be undone when the returned "unwind" object disposes -val UseThreadBuildPhase: phase: BuildPhase -> IDisposable +val UseBuildPhase: phase: BuildPhase -> IDisposable /// NOTE: The change will be undone when the returned "unwind" object disposes val UseTransformedDiagnosticsLogger: transformer: (DiagnosticsLogger -> #DiagnosticsLogger) -> IDisposable diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 5f339642dc7..b226484ef24 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -3049,7 +3049,7 @@ type FsiInteractionProcessor member _.EvalInteraction(ctok, sourceText, scriptFileName, diagnosticsLogger, ?cancellationToken) = let cancellationToken = defaultArg cancellationToken CancellationToken.None - use _ = UseThreadBuildPhase BuildPhase.Interactive + use _ = UseBuildPhase BuildPhase.Interactive use _ = UseDiagnosticsLogger diagnosticsLogger use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID let lexbuf = UnicodeLexing.StringAsLexbuf(true, tcConfigB.langVersion, sourceText) @@ -3066,7 +3066,7 @@ type FsiInteractionProcessor this.EvalInteraction (ctok, sourceText, scriptPath, diagnosticsLogger) member _.EvalExpression (ctok, sourceText, scriptFileName, diagnosticsLogger) = - use _unwind1 = UseThreadBuildPhase BuildPhase.Interactive + use _unwind1 = UseBuildPhase BuildPhase.Interactive use _unwind2 = UseDiagnosticsLogger diagnosticsLogger use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID let lexbuf = UnicodeLexing.StringAsLexbuf(true, tcConfigB.langVersion, sourceText) @@ -3645,7 +3645,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i if fsiOptions.IsInteractiveServer then SpawnInteractiveServer (fsi, fsiOptions, fsiConsoleOutput) - use _ = UseThreadBuildPhase BuildPhase.Interactive + use _ = UseBuildPhase BuildPhase.Interactive if fsiOptions.Interact then // page in the type check env diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 82cabdc24f9..364d2c3703d 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -2246,7 +2246,7 @@ module internal ParseAndCheckFile = // Make sure there is an DiagnosticsLogger installed whenever we do stuff that might record errors, even if we ultimately ignore the errors let delayedLogger = CapturingDiagnosticsLogger("matchBraces") use _ = UseDiagnosticsLogger delayedLogger - use _ = UseThreadBuildPhase BuildPhase.Parse + use _ = UseBuildPhase BuildPhase.Parse Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "matchBraces", fileName) @@ -2349,7 +2349,7 @@ module internal ParseAndCheckFile = use _ = UseDiagnosticsLogger errHandler.DiagnosticsLogger - use _ = UseThreadBuildPhase BuildPhase.Parse + use _ = UseBuildPhase BuildPhase.Parse let parseResult = usingLexbufForParsing (createLexbuf options.LangVersionText sourceText, fileName) (fun lexbuf -> @@ -2508,7 +2508,7 @@ module internal ParseAndCheckFile = use _ = UseDiagnosticsLogger errHandler.DiagnosticsLogger - use _unwindBP = UseThreadBuildPhase BuildPhase.TypeCheck + use _unwindBP = UseBuildPhase BuildPhase.TypeCheck // Apply nowarns to tcConfig (may generate errors, so ensure diagnosticsLogger is installed) let tcConfig = diff --git a/src/Compiler/Service/ServiceLexing.fs b/src/Compiler/Service/ServiceLexing.fs index 54e3a26f24d..cb9eacd954e 100644 --- a/src/Compiler/Service/ServiceLexing.fs +++ b/src/Compiler/Service/ServiceLexing.fs @@ -1049,7 +1049,7 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, maxLength: int option, fi // Scan a token starting with the given lexer state member x.ScanToken(lexState: FSharpTokenizerLexState) : FSharpTokenInfo option * FSharpTokenizerLexState = - use _ = UseThreadBuildPhase BuildPhase.Parse + use _ = UseBuildPhase BuildPhase.Parse use _ = UseDiagnosticsLogger DiscardErrorsLogger let indentationSyntaxStatus, lexcont = LexerStateEncoding.decodeLexInt lexState @@ -1835,7 +1835,7 @@ module FSharpLexerImpl = else lexer - use _ = UseThreadBuildPhase BuildPhase.Parse + use _ = UseBuildPhase BuildPhase.Parse use _ = UseDiagnosticsLogger DiscardErrorsLogger resetLexbufPos "" lexbuf diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index 88f001e20a2..026aeacdb20 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -113,7 +113,7 @@ module CompileHelpers = diagnostics, diagnosticsLogger, loggerProvider let tryCompile diagnosticsLogger f = - use _ = UseThreadBuildPhase BuildPhase.Parse + use _ = UseBuildPhase BuildPhase.Parse use _ = UseDiagnosticsLogger diagnosticsLogger let exiter = StopProcessingExiter() diff --git a/src/Compiler/Symbols/FSharpDiagnostic.fs b/src/Compiler/Symbols/FSharpDiagnostic.fs index 8e886c21b2b..afd6a9c634f 100644 --- a/src/Compiler/Symbols/FSharpDiagnostic.fs +++ b/src/Compiler/Symbols/FSharpDiagnostic.fs @@ -104,7 +104,7 @@ type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: str [] type DiagnosticsScope() = let mutable diags = [] - let unwindBP = UseThreadBuildPhase BuildPhase.TypeCheck + let unwindBP = UseBuildPhase BuildPhase.TypeCheck let unwindEL = UseDiagnosticsLogger { new DiagnosticsLogger("DiagnosticsScope") with diff --git a/src/Compiler/SyntaxTree/LexHelpers.fs b/src/Compiler/SyntaxTree/LexHelpers.fs index ae8b9deb615..ee6b39a5a93 100644 --- a/src/Compiler/SyntaxTree/LexHelpers.fs +++ b/src/Compiler/SyntaxTree/LexHelpers.fs @@ -97,7 +97,7 @@ let mkLexargs /// Register the lexbuf and call the given function let reusingLexbufForParsing lexbuf f = - use _ = UseThreadBuildPhase BuildPhase.Parse + use _ = UseBuildPhase BuildPhase.Parse LexbufLocalXmlDocStore.ClearXmlDoc lexbuf LexbufCommentStore.ClearComments lexbuf diff --git a/src/fsc/fscmain.fs b/src/fsc/fscmain.fs index d5a0572a66b..1f1d7109304 100644 --- a/src/fsc/fscmain.fs +++ b/src/fsc/fscmain.fs @@ -37,7 +37,7 @@ let main (argv) = Thread.CurrentThread.Name <- "F# Main Thread" // Set the initial phase to garbage collector to batch mode, which improves overall performance. - use _ = UseThreadBuildPhase BuildPhase.Parameter + use _ = UseBuildPhase BuildPhase.Parameter // An SDL recommendation UnmanagedProcessExecutionOptions.EnableHeapTerminationOnCorruption() From 2f7714128ebd2b6657c244c7b03964dd43d2cc68 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 23 Aug 2022 15:00:56 +0100 Subject: [PATCH 03/33] fix diagnostics --- src/Compiler/Checking/CheckDeclarations.fs | 8 +- src/Compiler/Driver/ParseAndCheckInputs.fs | 98 ++++++++++--------- src/Compiler/Driver/ParseAndCheckInputs.fsi | 4 - .../Service/FSharpParseFileResults.fs | 2 +- src/Compiler/Service/IncrementalBuild.fs | 6 +- .../Service/ServiceInterfaceStubGenerator.fs | 4 +- src/Compiler/Service/ServiceNavigation.fs | 16 ++- src/Compiler/Service/ServiceParseTreeWalk.fs | 3 +- src/Compiler/Service/ServiceParsedInputOps.fs | 12 +-- src/Compiler/Service/ServiceStructure.fs | 8 +- src/Compiler/Service/ServiceXmlDocParser.fs | 4 +- src/Compiler/SyntaxTree/SyntaxTree.fs | 57 +++++++++-- src/Compiler/SyntaxTree/SyntaxTree.fsi | 43 +++++++- src/Compiler/TypedTree/TypedTree.fsi | 2 +- tests/service/Common.fs | 2 +- tests/service/InteractiveCheckerTests.fs | 2 +- tests/service/Symbols.fs | 10 +- tests/service/SyntaxTreeTests/BindingTests.fs | 44 ++++----- .../ComputationExpressionTests.fs | 4 +- .../service/SyntaxTreeTests/EnumCaseTests.fs | 6 +- .../service/SyntaxTreeTests/ExceptionTests.fs | 2 +- .../SyntaxTreeTests/ExpressionTests.fs | 46 ++++----- .../SyntaxTreeTests/IfThenElseTests.fs | 16 +-- tests/service/SyntaxTreeTests/LambdaTests.fs | 18 ++-- .../SyntaxTreeTests/MatchClauseTests.fs | 24 ++--- tests/service/SyntaxTreeTests/MeasureTests.fs | 10 +- .../SyntaxTreeTests/MemberFlagTests.fs | 10 +- .../ModuleOrNamespaceSigTests.fs | 10 +- .../SyntaxTreeTests/ModuleOrNamespaceTests.fs | 14 +-- .../SyntaxTreeTests/NestedModuleTests.fs | 10 +- .../SyntaxTreeTests/OperatorNameTests.fs | 40 ++++---- .../ParsedHashDirectiveTests.fs | 8 +- tests/service/SyntaxTreeTests/PatternTests.fs | 10 +- .../SyntaxTreeTests/SignatureTypeTests.fs | 42 ++++---- .../SyntaxTreeTests/SourceIdentifierTests.fs | 6 +- tests/service/SyntaxTreeTests/StringTests.fs | 2 +- tests/service/SyntaxTreeTests/TypeTests.fs | 44 ++++----- .../service/SyntaxTreeTests/UnionCaseTests.fs | 10 +- tests/service/XmlDocTests.fs | 30 +++--- 39 files changed, 381 insertions(+), 306 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index d4c3644fcf1..b9ce8888979 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -5297,7 +5297,7 @@ let CheckOneImplFile /// Check an entire signature file -let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSink, isInternalTestSpanStackReferring) tcEnv (ParsedSigFileInput (qualifiedNameOfFile = qualNameOfFile; modules = sigFileFrags)) = +let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSink, isInternalTestSpanStackReferring) tcEnv (sigFile: ParsedSigFileInput) = cancellable { let cenv = cenv.Create @@ -5311,8 +5311,8 @@ let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSin let envinner, moduleTyAcc = MakeInitialEnv tcEnv - let specs = [ for x in sigFileFrags -> SynModuleSigDecl.NamespaceFragment x ] - let! tcEnv = TcSignatureElements cenv ParentNone qualNameOfFile.Range envinner PreXmlDoc.Empty None specs + let specs = [ for x in sigFile.Contents -> SynModuleSigDecl.NamespaceFragment x ] + let! tcEnv = TcSignatureElements cenv ParentNone sigFile.QualifiedName.Range envinner PreXmlDoc.Empty None specs let sigFileType = moduleTyAcc.Value @@ -5320,7 +5320,7 @@ let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSin try sigFileType |> IterTyconsOfModuleOrNamespaceType (fun tycon -> FinalTypeDefinitionChecksAtEndOfInferenceScope(cenv.infoReader, tcEnv.NameEnv, cenv.tcSink, false, tcEnv.DisplayEnv, tycon)) - with exn -> errorRecovery exn qualNameOfFile.Range + with exn -> errorRecovery exn sigFile.QualifiedName.Range return (tcEnv, sigFileType, cenv.createsGeneratedProvidedTypes) } diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 2d10b532a6a..b350e9dbb7b 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -215,11 +215,6 @@ let PostParseModuleSpec (_i, defaultNamespace, isLastCompiland, fileName, intf) SynModuleOrNamespaceSig(lid, isRecursive, kind, decls, xmlDoc, attributes, None, range, trivia) -let GetScopedPragmasForInput input = - match input with - | ParsedInput.SigFile (ParsedSigFileInput (scopedPragmas = pragmas)) -> pragmas - | ParsedInput.ImplFile (ParsedImplFileInput (scopedPragmas = pragmas)) -> pragmas - let GetScopedPragmasForHashDirective hd = [ match hd with @@ -459,7 +454,7 @@ let ParseInput else error (Error(FSComp.SR.buildInvalidSourceFileExtension fileName, rangeStartup)) - scopedPragmas <- GetScopedPragmasForInput input + scopedPragmas <- input.ScopedPragmas input finally // OK, now commit the errors, since the ScopedPragmas will (hopefully) have been scraped @@ -511,10 +506,10 @@ let ReportParsingStatistics res = let flattenModImpl (SynModuleOrNamespace (decls = decls)) = flattenDefns decls match res with - | ParsedInput.SigFile (ParsedSigFileInput (modules = specs)) -> - printfn "parsing yielded %d specs" (List.collect flattenModSpec specs).Length - | ParsedInput.ImplFile (ParsedImplFileInput (modules = impls)) -> - printfn "parsing yielded %d definitions" (List.collect flattenModImpl impls).Length + | ParsedInput.SigFile sigFile -> + printfn "parsing yielded %d specs" (List.collect flattenModSpec sigFile.Contents).Length + | ParsedInput.ImplFile implFile -> + printfn "parsing yielded %d definitions" (List.collect flattenModImpl implFile.Contents).Length let EmptyParsedInput (fileName, isLastCompiland) = if FSharpSigFileSuffixes |> List.exists (FileSystemUtils.checkSuffix fileName) then @@ -882,7 +877,7 @@ let ProcessMetaCommandsFromInput let canHaveScriptMetaCommands = match inp with | ParsedInput.SigFile _ -> false - | ParsedInput.ImplFile (ParsedImplFileInput (isScript = isScript)) -> isScript + | ParsedInput.ImplFile file -> file.IsScript let ProcessDependencyManagerDirective directive args m state = if not canHaveScriptMetaCommands then @@ -1000,13 +995,13 @@ let ProcessMetaCommandsFromInput decls match inp with - | ParsedInput.SigFile (ParsedSigFileInput (hashDirectives = hashDirectives; modules = specs)) -> - let state = List.fold ProcessMetaCommand state0 hashDirectives - let state = List.fold ProcessMetaCommandsFromModuleSpec state specs + | ParsedInput.SigFile sigFile -> + let state = List.fold ProcessMetaCommand state0 sigFile.HashDirectives + let state = List.fold ProcessMetaCommandsFromModuleSpec state sigFile.Contents state - | ParsedInput.ImplFile (ParsedImplFileInput (hashDirectives = hashDirectives; modules = impls)) -> - let state = List.fold ProcessMetaCommand state0 hashDirectives - let state = List.fold ProcessMetaCommandsFromModuleImpl state impls + | ParsedInput.ImplFile implFile -> + let state = List.fold ProcessMetaCommand state0 implFile.HashDirectives + let state = List.fold ProcessMetaCommandsFromModuleImpl state implFile.Contents state let ApplyNoWarnsToTcConfig (tcConfig: TcConfig, inp: ParsedInput, pathOfMetaCommandSource) = @@ -1141,11 +1136,6 @@ type TcState = tcsTcImplEnv = tcEnvAtEndOfLastInput } - member x.RemoveImpl qualifiedNameOfFile = - { x with - tcsRootImpls = x.tcsRootImpls.Remove(qualifiedNameOfFile) - } - /// Create the initial type checking state for compiling an assembly let GetInitialTcState (m, ccuName, tcConfig: TcConfig, tcGlobals, tcImports: TcImports, tcEnv0, openDecls0) = ignore tcImports @@ -1194,7 +1184,7 @@ let GetInitialTcState (m, ccuName, tcConfig: TcConfig, tcGlobals, tcImports: TcI /// Dummy typed impl file that contains no definitions and is not used for emitting any kind of assembly. let CreateEmptyDummyImplFile qualNameOfFile sigTy = - CheckedImplFile.CheckedImplFile(qualNameOfFile, [], sigTy, ModuleOrNamespaceContents.TMDefs [], false, false, StampMap [], Map.empty) + CheckedImplFile(qualNameOfFile, [], sigTy, ModuleOrNamespaceContents.TMDefs [], false, false, StampMap [], Map.empty) let AddCheckResultsToTcState (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcImplEnv, qualNameOfFile, implFileSigType) @@ -1243,14 +1233,13 @@ let AddCheckResultsToTcState ccuSigForFile, tcState -let AddDummyCheckResultsToTcState (tcGlobals, amap, file, prefixPathOpt, tcSink, tcState: TcState, tcStateForImplFile: TcState, rootSig) = - let (ParsedImplFileInput (qualifiedNameOfFile = qualNameOfFile)) = file +let AddDummyCheckResultsToTcState (tcGlobals, amap, qualName: QualifiedNameOfFile, prefixPathOpt, tcSink, tcState: TcState, tcStateForImplFile: TcState, rootSig) = let hadSig = true - let emptyImplFile = CreateEmptyDummyImplFile qualNameOfFile rootSig + let emptyImplFile = CreateEmptyDummyImplFile qualName rootSig let tcEnvAtEnd = tcStateForImplFile.TcEnvFromImpls let ccuSigForFile, tcState = - AddCheckResultsToTcState (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, rootSig) tcState + AddCheckResultsToTcState (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualName, rootSig) tcState (tcEnvAtEnd, EmptyTopAttrs, Some emptyImplFile, ccuSigForFile), tcState @@ -1276,7 +1265,9 @@ let CheckOneInputAux let amap = tcImports.GetImportMap() match inp with - | ParsedInput.SigFile (ParsedSigFileInput (qualifiedNameOfFile = qualNameOfFile) as file) -> + | ParsedInput.SigFile file -> + + let qualNameOfFile = file.QualifiedName // Check if we've seen this top module signature before. if Zmap.mem qualNameOfFile tcState.tcsRootSigs then @@ -1329,7 +1320,7 @@ let CheckOneInputAux return Choice1Of2(tcEnv, EmptyTopAttrs, None, ccuSigForFile), tcState | ParsedInput.ImplFile file -> - let (ParsedImplFileInput (qualifiedNameOfFile = qualNameOfFile)) = file + let qualNameOfFile = file.QualifiedName // Check if we've got an interface for this fragment let rootSigOpt = tcState.tcsRootSigs.TryFind qualNameOfFile @@ -1352,18 +1343,16 @@ let CheckOneInputAux // Adjust the TcState as if it has been checked, which makes the signature for the file available later // in the compilation order. let tcStateForImplFile = tcState - //let ccuSigForFile, tcState = AddDummyCheckResultsToTcState (tcGlobals, amap, file, prefixPathOpt, tcSink, tcState, tcStateForImplFile, rootSig) - let (ParsedImplFileInput (qualifiedNameOfFile = qualNameOfFile)) = file + let qualNameOfFile = file.QualifiedName let hadSig = true - //let emptyImplFile = CreateEmptyDummyImplFile qualNameOfFile rootSig - //let tcEnvAtEnd = tcStateForImplFile.TcEnvFromImpls + let priorErrors = checkForErrors() let ccuSigForFile, tcState = AddCheckResultsToTcState (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, rootSig) tcState let partialResult = - (amap, conditionalDefines, rootSig, file, tcStateForImplFile, ccuSigForFile) + (amap, conditionalDefines, rootSig, priorErrors, file, tcStateForImplFile, ccuSigForFile) return Choice2Of2 partialResult, tcState @@ -1422,13 +1411,13 @@ let CheckOneInput match partialResult with | Choice1Of2 result -> return result, tcState - | Choice2Of2 (amap, _conditionalDefines, rootSig, file, tcStateForImplFile, _ccuSigForFile) -> - return AddDummyCheckResultsToTcState(tcGlobals, amap, file, prefixPathOpt, tcSink, tcState, tcStateForImplFile, rootSig) + | Choice2Of2 (amap, _conditionalDefines, rootSig, _priorErrors, file, tcStateForImplFile, _ccuSigForFile) -> + return AddDummyCheckResultsToTcState(tcGlobals, amap, file.QualifiedName, prefixPathOpt, tcSink, tcState, tcStateForImplFile, rootSig) } // Within a file, equip loggers to locally filter w.r.t. scope pragmas in each input -let DiagnosticsLoggerForInput (tcConfig: TcConfig, input, oldLogger) = - GetDiagnosticsLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput input, tcConfig.diagnosticsOptions, oldLogger) +let DiagnosticsLoggerForInput (tcConfig: TcConfig, input: ParsedInput, oldLogger) = + GetDiagnosticsLoggerFilteringByScopedPragmas(false, input.ScopedPragmas, tcConfig.diagnosticsOptions, oldLogger) /// Typecheck a single file (or interactive entry into F# Interactive) let CheckOneInputEntry (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, skipImplIfSigExists) tcState input = @@ -1482,9 +1471,11 @@ let CheckMultipleInputsSequential (ctok, checkForErrors, tcConfig, tcImports, tc (tcState, inputs) ||> List.mapFold (CheckOneInputEntry(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, false)) +/// Use parallel checking of implementation files that have signature files let CheckMultipleInputsInParallel ( ctok, + checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, @@ -1508,17 +1499,26 @@ let CheckMultipleInputsInParallel let logger = DiagnosticsLoggerForInput(tcConfig, input, oldLogger) input, logger) + // In the first linear part of parallel checking, we use a 'checkForErrors' that checks either for errors + // somewhere in the files processed prior to each one, or in the processing of this particular file. + let priorErrors = checkForErrors() + // Do the first linear phase, checking all signatures and any implementation files that don't have a signature. // Implementation files that do have a signature will result in a Choice2Of2 indicating to next do some of the // checking in parallel. - let partialResults, tcState = - (tcState, inputsWithLoggers) - ||> List.mapFold (fun tcState (input, logger) -> + let partialResults, (tcState, _) = + ((tcState, priorErrors), inputsWithLoggers) + ||> List.mapFold (fun (tcState, priorErrors) (input, logger) -> use _ = UseDiagnosticsLogger logger - let checkForErrors () = (logger.ErrorCount > 0) - CheckOneInputAux(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, input, true) - |> Cancellable.runWithoutCancellation) + let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0) + + let partialResult, tcState = + CheckOneInputAux(checkForErrors2, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, input, true) + |> Cancellable.runWithoutCancellation + + let priorErrors = checkForErrors2() + partialResult, (tcState, priorErrors)) // Do the parallel phase, checking all implementation files that did have a signature, in parallel. let unfinishedResults = @@ -1533,9 +1533,12 @@ let CheckMultipleInputsInParallel match partialResult with | Choice1Of2 result -> Choice1Of2 result - | Choice2Of2 (amap, conditionalDefines, rootSig, file, tcStateForImplFile, ccuSigForFile) -> + | Choice2Of2 (amap, conditionalDefines, rootSig, priorErrors, file, tcStateForImplFile, ccuSigForFile) -> - let checkForErrors () = (logger.ErrorCount > 0) + // In the first linear part of parallel checking, we use a 'checkForErrors' that checks either for errors + // somewhere in the files processed prior to this one, including from the first phase, or in the processing + // of this particular file. + let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0) let topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes = CheckOneImplFile( @@ -1543,7 +1546,7 @@ let CheckMultipleInputsInParallel amap, tcStateForImplFile.tcsCcu, tcStateForImplFile.tcsImplicitOpenDeclarations, - checkForErrors, + checkForErrors2, conditionalDefines, TcResultsSink.NoSink, tcConfig.internalTestSpanStackReferring, @@ -1600,6 +1603,7 @@ let CheckClosedInputSet if tcConfig.concurrentBuild && not disableParallel then CheckMultipleInputsInParallel( ctok, + checkForErrors, tcConfig, tcImports, tcGlobals, diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index 5a8e6a64d24..355c8a67037 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -54,8 +54,6 @@ val ApplyMetaCommandsFromInputToTcConfig: TcConfig * ParsedInput * string * Depe /// Process the #nowarn in an input and integrate them into the TcConfig val ApplyNoWarnsToTcConfig: TcConfig * ParsedInput * string -> TcConfig -val GetScopedPragmasForInput: input: ParsedInput -> ScopedPragma list - /// Parse one input stream val ParseOneInputStream: tcConfig: TcConfig * @@ -133,8 +131,6 @@ type TcState = member CreatesGeneratedProvidedTypes: bool - member RemoveImpl: QualifiedNameOfFile -> TcState - /// Get the initial type checking state for a set of inputs val GetInitialTcState: range * string * TcConfig * TcGlobals * TcImports * TcEnv * OpenDeclaration list -> TcState diff --git a/src/Compiler/Service/FSharpParseFileResults.fs b/src/Compiler/Service/FSharpParseFileResults.fs index fe5afbfc4ab..de8d6ae60da 100644 --- a/src/Compiler/Service/FSharpParseFileResults.fs +++ b/src/Compiler/Service/FSharpParseFileResults.fs @@ -937,7 +937,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, let walkImplFile (modules: SynModuleOrNamespace list) = List.collect walkModule modules match input with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = modules)) -> walkImplFile modules + | ParsedInput.ImplFile file -> walkImplFile file.Contents | _ -> [] DiagnosticsScope.Protect diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index a1f5d0b0559..fd1b8e60bec 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -475,7 +475,7 @@ type BoundModel private (tcConfig: TcConfig, IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBETypechecked fileName) let capturingDiagnosticsLogger = CapturingDiagnosticsLogger("TypeCheck") - let diagnosticsLogger = GetDiagnosticsLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput input, tcConfig.diagnosticsOptions, capturingDiagnosticsLogger) + let diagnosticsLogger = GetDiagnosticsLoggerFilteringByScopedPragmas(false, input.ScopedPragmas, tcConfig.diagnosticsOptions, capturingDiagnosticsLogger) use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.TypeCheck) beforeFileChecked.Trigger fileName @@ -519,8 +519,8 @@ type BoundModel private (tcConfig: TcConfig, tcDependencyFiles = fileName :: prevTcDependencyFiles sigNameOpt = match input with - | ParsedInput.SigFile(ParsedSigFileInput(fileName=fileName;qualifiedNameOfFile=qualName)) -> - Some(fileName, qualName) + | ParsedInput.SigFile sigFile -> + Some(sigFile.FileName, sigFile.QualifiedName) | _ -> None } diff --git a/src/Compiler/Service/ServiceInterfaceStubGenerator.fs b/src/Compiler/Service/ServiceInterfaceStubGenerator.fs index 410d02dc786..bf28a121d43 100644 --- a/src/Compiler/Service/ServiceInterfaceStubGenerator.fs +++ b/src/Compiler/Service/ServiceInterfaceStubGenerator.fs @@ -780,8 +780,8 @@ module InterfaceStubGenerator = /// Find corresponding interface declaration at a given position let TryFindInterfaceDeclaration (pos: pos) (parsedInput: ParsedInput) = - let rec walkImplFileInput (ParsedImplFileInput (modules = moduleOrNamespaceList)) = - List.tryPick walkSynModuleOrNamespace moduleOrNamespaceList + let rec walkImplFileInput (file: ParsedImplFileInput) = + List.tryPick walkSynModuleOrNamespace file.Contents and walkSynModuleOrNamespace (SynModuleOrNamespace (decls = decls; range = range)) = if not <| rangeContainsPos range pos then diff --git a/src/Compiler/Service/ServiceNavigation.fs b/src/Compiler/Service/ServiceNavigation.fs index 11ebea8a668..c38ce9793e2 100755 --- a/src/Compiler/Service/ServiceNavigation.fs +++ b/src/Compiler/Service/ServiceNavigation.fs @@ -662,8 +662,8 @@ module NavigationImpl = module Navigation = let getNavigation (parsedInput: ParsedInput) = match parsedInput with - | ParsedInput.SigFile (ParsedSigFileInput (modules = modules)) -> NavigationImpl.getNavigationFromSigFile modules - | ParsedInput.ImplFile (ParsedImplFileInput (modules = modules)) -> NavigationImpl.getNavigationFromImplFile modules + | ParsedInput.SigFile file -> NavigationImpl.getNavigationFromSigFile file.Contents + | ParsedInput.ImplFile file -> NavigationImpl.getNavigationFromImplFile file.Contents let empty = NavigationItems([||]) @@ -819,15 +819,14 @@ module NavigateTo = let ctor = mapMemberKind memberFlags.MemberKind addValSig ctor valSig isSig container - let rec walkSigFileInput (inp: ParsedSigFileInput) = - let (ParsedSigFileInput (fileName = fileName; modules = moduleOrNamespaceList)) = inp + let rec walkSigFileInput (file: ParsedSigFileInput) = - for item in moduleOrNamespaceList do + for item in file.Contents do walkSynModuleOrNamespaceSig item { Type = NavigableContainerType.File - LogicalName = fileName + LogicalName = file.FileName } and walkSynModuleOrNamespaceSig (inp: SynModuleOrNamespaceSig) container = @@ -890,15 +889,14 @@ module NavigateTo = | SynMemberSig.Interface _ -> () and walkImplFileInput (inp: ParsedImplFileInput) = - let (ParsedImplFileInput (fileName = fileName; modules = moduleOrNamespaceList)) = inp let container = { Type = NavigableContainerType.File - LogicalName = fileName + LogicalName = inp.FileName } - for item in moduleOrNamespaceList do + for item in inp.Contents do walkSynModuleOrNamespace item container and walkSynModuleOrNamespace inp container = diff --git a/src/Compiler/Service/ServiceParseTreeWalk.fs b/src/Compiler/Service/ServiceParseTreeWalk.fs index 9a4263d4975..5e36b71fca5 100755 --- a/src/Compiler/Service/ServiceParseTreeWalk.fs +++ b/src/Compiler/Service/ServiceParseTreeWalk.fs @@ -973,7 +973,8 @@ module SyntaxTraversal = visitor.VisitBinding(origPath, defaultTraverse, b) match parseTree with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = l)) -> + | ParsedInput.ImplFile file -> + let l = file.Contents let fileRange = #if DEBUG match l with diff --git a/src/Compiler/Service/ServiceParsedInputOps.fs b/src/Compiler/Service/ServiceParsedInputOps.fs index 7b1fc766c1d..6b6a1c906f0 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fs +++ b/src/Compiler/Service/ServiceParsedInputOps.fs @@ -570,8 +570,8 @@ module ParsedInput = let inline ifPosInRange range f = if isPosInRange range then f () else None - let rec walkImplFileInput (ParsedImplFileInput (modules = moduleOrNamespaceList)) = - List.tryPick (walkSynModuleOrNamespace true) moduleOrNamespaceList + let rec walkImplFileInput (file: ParsedImplFileInput) = + List.tryPick (walkSynModuleOrNamespace true) file.Contents and walkSynModuleOrNamespace isTopLevel inp = let (SynModuleOrNamespace (decls = decls; attribs = Attributes attrs; range = r)) = @@ -1589,8 +1589,8 @@ module ParsedInput = let addIdent (ident: Ident) = identsByEndPos[ident.idRange.End] <- [ ident ] - let rec walkImplFileInput (ParsedImplFileInput (modules = moduleOrNamespaceList)) = - List.iter walkSynModuleOrNamespace moduleOrNamespaceList + let rec walkImplFileInput (file: ParsedImplFileInput) = + List.iter walkSynModuleOrNamespace file.Contents and walkSynModuleOrNamespace (SynModuleOrNamespace (decls = decls; attribs = Attributes attrs)) = List.iter walkAttribute attrs @@ -2069,8 +2069,8 @@ module ParsedInput = | _ -> None |> Option.map (fun r -> r.StartColumn) - let rec walkImplFileInput (ParsedImplFileInput (modules = moduleOrNamespaceList)) = - List.iter (walkSynModuleOrNamespace []) moduleOrNamespaceList + let rec walkImplFileInput (file: ParsedImplFileInput) = + List.iter (walkSynModuleOrNamespace []) file.Contents and walkSynModuleOrNamespace (parent: LongIdent) modul = let (SynModuleOrNamespace (longId = ident; kind = kind; decls = decls; range = range)) = diff --git a/src/Compiler/Service/ServiceStructure.fs b/src/Compiler/Service/ServiceStructure.fs index cbc625f709b..210f3f4f9e8 100644 --- a/src/Compiler/Service/ServiceStructure.fs +++ b/src/Compiler/Service/ServiceStructure.fs @@ -1045,11 +1045,11 @@ module Structure = List.iter parseModuleSigDeclaration decls match parsedInput with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = modules)) -> - modules |> List.iter parseModuleOrNamespace + | ParsedInput.ImplFile file -> + file.Contents |> List.iter parseModuleOrNamespace getCommentRanges sourceLines - | ParsedInput.SigFile (ParsedSigFileInput (modules = moduleSigs)) -> - List.iter parseModuleOrNamespaceSigs moduleSigs + | ParsedInput.SigFile file -> + file.Contents |> List.iter parseModuleOrNamespaceSigs getCommentRanges sourceLines acc :> seq<_> diff --git a/src/Compiler/Service/ServiceXmlDocParser.fs b/src/Compiler/Service/ServiceXmlDocParser.fs index f0b137b4bb8..ce509056cb1 100644 --- a/src/Compiler/Service/ServiceXmlDocParser.fs +++ b/src/Compiler/Service/ServiceXmlDocParser.fs @@ -210,8 +210,8 @@ module XmlDocParsing = and getXmlDocablesInput input = match input with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = symModules)) -> - symModules |> List.collect getXmlDocablesSynModuleOrNamespace + | ParsedInput.ImplFile file -> + file.Contents |> List.collect getXmlDocablesSynModuleOrNamespace | ParsedInput.SigFile _ -> [] // Get compiler options for the 'project' implied by a single script file diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fs b/src/Compiler/SyntaxTree/SyntaxTree.fs index ce5571ab4d9..977f63da92d 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fs +++ b/src/Compiler/SyntaxTree/SyntaxTree.fs @@ -1676,10 +1676,28 @@ type ParsedImplFileInput = qualifiedNameOfFile: QualifiedNameOfFile * scopedPragmas: ScopedPragma list * hashDirectives: ParsedHashDirective list * - modules: SynModuleOrNamespace list * - isLastCompiland: (bool * bool) * + contents: SynModuleOrNamespace list * + flags: (bool * bool) * trivia: ParsedImplFileInputTrivia + member x.QualifiedName = (let (ParsedImplFileInput (qualifiedNameOfFile = qualNameOfFile)) = x in qualNameOfFile) + + member x.ScopedPragmas = (let (ParsedImplFileInput (scopedPragmas = scopedPragmas)) = x in scopedPragmas) + + member x.HashDirectives = (let (ParsedImplFileInput (hashDirectives = hashDirectives)) = x in hashDirectives) + + member x.FileName = (let (ParsedImplFileInput (fileName = fileName)) = x in fileName) + + member x.Contents = (let (ParsedImplFileInput (contents = contents)) = x in contents) + + member x.IsScript = (let (ParsedImplFileInput (isScript = isScript)) = x in isScript) + + member x.IsLastCompiland = (let (ParsedImplFileInput (flags = (isLastCompiland, _))) = x in isLastCompiland) + + member x.IsExe = (let (ParsedImplFileInput (flags = (_, isExe))) = x in isExe) + + member x.Trivia = (let (ParsedImplFileInput (trivia = trivia)) = x in trivia) + [] type ParsedSigFileInput = | ParsedSigFileInput of @@ -1687,9 +1705,21 @@ type ParsedSigFileInput = qualifiedNameOfFile: QualifiedNameOfFile * scopedPragmas: ScopedPragma list * hashDirectives: ParsedHashDirective list * - modules: SynModuleOrNamespaceSig list * + contents: SynModuleOrNamespaceSig list * trivia: ParsedSigFileInputTrivia + member x.QualifiedName = (let (ParsedSigFileInput (qualifiedNameOfFile = qualNameOfFile)) = x in qualNameOfFile) + + member x.ScopedPragmas = (let (ParsedSigFileInput (scopedPragmas = scopedPragmas)) = x in scopedPragmas) + + member x.HashDirectives = (let (ParsedSigFileInput (hashDirectives = hashDirectives)) = x in hashDirectives) + + member x.FileName = (let (ParsedSigFileInput (fileName = fileName)) = x in fileName) + + member x.Contents = (let (ParsedSigFileInput (contents = contents)) = x in contents) + + member x.Trivia = (let (ParsedSigFileInput (trivia = trivia)) = x in trivia) + [] type ParsedInput = | ImplFile of ParsedImplFileInput @@ -1698,12 +1728,21 @@ type ParsedInput = member inp.FileName = match inp with - | ParsedInput.ImplFile (ParsedImplFileInput (fileName = fileName)) - | ParsedInput.SigFile (ParsedSigFileInput (fileName = fileName)) -> fileName + | ParsedInput.ImplFile file -> file.FileName + | ParsedInput.SigFile file -> file.FileName + + member inp.ScopedPragmas = + match inp with + | ParsedInput.ImplFile file -> file.ScopedPragmas + | ParsedInput.SigFile file -> file.ScopedPragmas + + member inp.QualifiedName = + match inp with + | ParsedInput.ImplFile file -> file.QualifiedName + | ParsedInput.SigFile file -> file.QualifiedName member inp.Range = match inp with - | ParsedInput.ImplFile (ParsedImplFileInput(modules = SynModuleOrNamespace (range = m) :: _)) - | ParsedInput.SigFile (ParsedSigFileInput(modules = SynModuleOrNamespaceSig (range = m) :: _)) -> m - | ParsedInput.ImplFile (ParsedImplFileInput (fileName = fileName)) - | ParsedInput.SigFile (ParsedSigFileInput (fileName = fileName)) -> rangeN fileName 0 + | ParsedInput.ImplFile (ParsedImplFileInput(contents = SynModuleOrNamespace (range = m) :: _)) + | ParsedInput.SigFile (ParsedSigFileInput(contents = SynModuleOrNamespaceSig (range = m) :: _)) -> m + | _ -> rangeN inp.FileName 0 diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fsi b/src/Compiler/SyntaxTree/SyntaxTree.fsi index 2af399af0e4..d777f8cd2f9 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTree.fsi @@ -1882,10 +1882,28 @@ type ParsedImplFileInput = qualifiedNameOfFile: QualifiedNameOfFile * scopedPragmas: ScopedPragma list * hashDirectives: ParsedHashDirective list * - modules: SynModuleOrNamespace list * - isLastCompiland: (bool * bool) * + contents: SynModuleOrNamespace list * + flags: (bool * bool) * trivia: ParsedImplFileInputTrivia + member FileName: string + + member IsScript: bool + + member QualifiedName: QualifiedNameOfFile + + member ScopedPragmas: ScopedPragma list + + member HashDirectives: ParsedHashDirective list + + member Contents: SynModuleOrNamespace list + + member Trivia: ParsedImplFileInputTrivia + + member IsLastCompiland: bool + + member IsExe: bool + /// Represents the full syntax tree, file name and other parsing information for a signature file [] type ParsedSigFileInput = @@ -1894,9 +1912,21 @@ type ParsedSigFileInput = qualifiedNameOfFile: QualifiedNameOfFile * scopedPragmas: ScopedPragma list * hashDirectives: ParsedHashDirective list * - modules: SynModuleOrNamespaceSig list * + contents: SynModuleOrNamespaceSig list * trivia: ParsedSigFileInputTrivia + member FileName: string + + member QualifiedName: QualifiedNameOfFile + + member ScopedPragmas: ScopedPragma list + + member HashDirectives: ParsedHashDirective list + + member Contents: SynModuleOrNamespaceSig list + + member Trivia: ParsedSigFileInputTrivia + /// Represents the syntax tree for a parsed implementation or signature file [] type ParsedInput = @@ -1911,3 +1941,10 @@ type ParsedInput = /// Gets the syntax range of this construct member Range: range + + /// Gets the qualified name used to help match signature and implementation files + member QualifiedName: QualifiedNameOfFile + + /// Gets the #nowarn and other scoped pragmas + member ScopedPragmas: ScopedPragma list + diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index d55e5e40706..b63942d2c8c 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -3923,7 +3923,7 @@ type CheckedImplFile = member Signature: ModuleOrNamespaceType -/// Represents a complete typechecked assembly, made up of multiple implementation files. +/// Represents checked file, after optimization, equipped with the ability to do further optimization of expressions. [] type CheckedImplFileAfterOptimization = { ImplFile: CheckedImplFile diff --git a/tests/service/Common.fs b/tests/service/Common.fs index fe50b7b5a8e..7f2a8e56813 100644 --- a/tests/service/Common.fs +++ b/tests/service/Common.fs @@ -210,7 +210,7 @@ let matchBraces (name: string, code: string) = let getSingleModuleLikeDecl (input: ParsedInput) = match input with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ decl ])) -> decl + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ decl ])) -> decl | _ -> failwith "Could not get module decls" let getSingleModuleMemberDecls (input: ParsedInput) = diff --git a/tests/service/InteractiveCheckerTests.fs b/tests/service/InteractiveCheckerTests.fs index ac208f8f6a3..d8494d490ed 100644 --- a/tests/service/InteractiveCheckerTests.fs +++ b/tests/service/InteractiveCheckerTests.fs @@ -54,7 +54,7 @@ let internal identsAndRanges (input: ParsedInput) = (identAndRange (longIdentToString longIdent) (longIdent |> List.map (fun id -> id.idRange) |> List.reduce unionRanges)) :: xs match input with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = modulesOrNamespaces)) -> + | ParsedInput.ImplFile(ParsedImplFileInput(contents = modulesOrNamespaces)) -> modulesOrNamespaces |> List.collect extractFromModuleOrNamespace | ParsedInput.SigFile _ -> [] diff --git a/tests/service/Symbols.fs b/tests/service/Symbols.fs index b6af2161a86..d9cb28398b9 100644 --- a/tests/service/Symbols.fs +++ b/tests/service/Symbols.fs @@ -98,7 +98,7 @@ extern int private c() extern int AccessibleChildren()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(false, [ SynBinding(range = mb) ] , ml) ]) ])) -> assertRange (2, 0) (3, 31) ml @@ -113,7 +113,7 @@ extern void setCallbridgeSupportTarget(IntPtr newTarget) """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(false, [ SynBinding(returnInfo = Some (SynBindingReturnInfo(typeName = @@ -133,7 +133,7 @@ extern int AccessibleChildren(int* x) """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(false, [ SynBinding(headPat = SynPat.LongIdent(argPats = SynArgPats.Pats [ @@ -157,7 +157,7 @@ extern int AccessibleChildren(obj& x) """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(false, [ SynBinding(headPat = SynPat.LongIdent(argPats = SynArgPats.Pats [ @@ -181,7 +181,7 @@ extern int AccessibleChildren(void* x) """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(false, [ SynBinding(headPat = SynPat.LongIdent(argPats = SynArgPats.Pats [ diff --git a/tests/service/SyntaxTreeTests/BindingTests.fs b/tests/service/SyntaxTreeTests/BindingTests.fs index c132b306ecd..95ea6685947 100644 --- a/tests/service/SyntaxTreeTests/BindingTests.fs +++ b/tests/service/SyntaxTreeTests/BindingTests.fs @@ -13,7 +13,7 @@ let ``Range of attribute should be included in SynModuleDecl.Let`` () = let a = 0""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(range = mb)]) as lt ]) ])) -> assertRange (2, 0) (3, 5) mb @@ -28,7 +28,7 @@ let ``Range of attribute between let keyword and pattern should be included in S let [] (A x) = 1""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(range = mb)]) as lt ]) ])) -> assertRange (2, 4) (2, 21) mb @@ -45,7 +45,7 @@ type Bar = let x = 8""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [SynMemberDefn.LetBindings(bindings = [SynBinding(range = mb)]) as m]))]) ]) ])) -> assertRange (3, 4) (4, 9) mb @@ -62,7 +62,7 @@ type Bar = member this.Something () = ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [SynMemberDefn.Member(memberDefn = SynBinding(range = mb)) as m]))]) ]) ])) -> assertRange (3, 4) (4, 28) mb @@ -79,7 +79,7 @@ let ``Range of attribute should be included in binding of SynExpr.ObjExpr`` () = member x.ToString() = "F#" }""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.ObjExpr(members = [SynMemberDefn.Member(memberDefn=SynBinding(range = mb))])) ]) ])) -> assertRange (3, 4) (4, 23) mb @@ -95,7 +95,7 @@ type Tiger = new () = ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [SynMemberDefn.Member(memberDefn = SynBinding(range = mb)) as m]))]) ]) ])) -> assertRange (3, 4) (4, 10) mb @@ -112,7 +112,7 @@ type Tiger = new () as tony = ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [SynMemberDefn.Member(memberDefn = SynBinding(range = mb)) as m]))]) ]) ])) -> assertRange (3, 4) (4, 18) mb @@ -136,7 +136,7 @@ type T() = T ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [ SynMemberDefn.ImplicitCtor _ SynMemberDefn.Member(memberDefn = SynBinding(range = mb1)) as m1 @@ -162,7 +162,7 @@ type Crane = member this.MyWriteOnlyProperty with set (value) = myInternalValue <- value""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [SynMemberDefn.GetSetMember(memberDefnForSet = Some (SynBinding(range = mb))) as m]))]) ]) ])) -> @@ -182,7 +182,7 @@ type Bird = and set (value) = myInternalValue <- value""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [ SynMemberDefn.GetSetMember(Some (SynBinding(range = mb1)), Some (SynBinding(range = mb2)), m, _) ]))]) @@ -198,7 +198,7 @@ let ``Range of equal sign should be present in SynModuleDecl.Let binding`` () = getParseResults "let v = 12" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(trivia={ EqualsRange = Some mEquals })]) ]) ])) -> assertRange (1, 6) (1, 7) mEquals @@ -210,7 +210,7 @@ let ``Range of equal sign should be present in SynModuleDecl.Let binding, typed` getParseResults "let v : int = 12" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(trivia={ EqualsRange = Some mEquals })]) ]) ])) -> assertRange (1, 12) (1, 13) mEquals @@ -227,7 +227,7 @@ do """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Do(expr = SynExpr.LetOrUse(bindings = [SynBinding(trivia={ EqualsRange = Some mEquals })]))) ]) ])) -> assertRange (3, 10) (3, 11) mEquals @@ -244,7 +244,7 @@ do """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Do(expr = SynExpr.LetOrUse(bindings = [SynBinding(trivia={ EqualsRange = Some mEquals })]))) ]) ])) -> assertRange (3, 15) (3, 16) mEquals @@ -260,7 +260,7 @@ type X() = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [ _; SynMemberDefn.Member(memberDefn = SynBinding(trivia={ EqualsRange = Some mEquals }))]))]) ]) ])) -> assertRange (3, 18) (3, 19) mEquals @@ -276,7 +276,7 @@ type X() = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [ _; SynMemberDefn.Member(memberDefn = SynBinding(trivia={ EqualsRange = Some mEquals }))]))]) ]) ])) -> assertRange (3, 21) (3, 22) mEquals @@ -292,7 +292,7 @@ type X() = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [ _; SynMemberDefn.Member(memberDefn = SynBinding(trivia={ EqualsRange = Some mEquals }))]))]) ]) ])) -> assertRange (3, 30) (3, 31) mEquals @@ -310,7 +310,7 @@ type Y() = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [ _ SynMemberDefn.GetSetMember( @@ -328,7 +328,7 @@ let ``Range of let keyword should be present in SynModuleDecl.Let binding`` () = getParseResults "let v = 12" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(trivia={ LetKeyword = Some mLet })]) ]) ])) -> assertRange (1, 0) (1, 3) mLet @@ -345,7 +345,7 @@ let v = 12 """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(trivia={ LetKeyword = Some mLet })]) ]) ])) -> assertRange (5, 0) (5, 3) mLet @@ -361,7 +361,7 @@ let a = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(expr=SynExpr.LetOrUse(bindings=[SynBinding(trivia={ LetKeyword = Some mLet })]))]) ]) ])) -> assertRange (3, 4) (3, 7) mLet @@ -376,7 +376,7 @@ let b : int * string * bool = 1, "", false """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [ SynBinding(returnInfo = Some (SynBindingReturnInfo(typeName = SynType.Tuple(path = [ diff --git a/tests/service/SyntaxTreeTests/ComputationExpressionTests.fs b/tests/service/SyntaxTreeTests/ComputationExpressionTests.fs index 5a1de7621bd..243a06165c8 100644 --- a/tests/service/SyntaxTreeTests/ComputationExpressionTests.fs +++ b/tests/service/SyntaxTreeTests/ComputationExpressionTests.fs @@ -18,7 +18,7 @@ async { """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr (expr = SynExpr.App(argExpr = SynExpr.ComputationExpr(expr = SynExpr.LetOrUseBang(andBangs = [ SynExprAndBang(range = mAndBang) @@ -42,7 +42,7 @@ async { """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr (expr = SynExpr.App(argExpr = SynExpr.ComputationExpr(expr = SynExpr.LetOrUseBang(andBangs = [ SynExprAndBang(range = mAndBang1; trivia={ InKeyword = Some mIn }) diff --git a/tests/service/SyntaxTreeTests/EnumCaseTests.fs b/tests/service/SyntaxTreeTests/EnumCaseTests.fs index 60dd4a1e6eb..1363ab095ac 100644 --- a/tests/service/SyntaxTreeTests/EnumCaseTests.fs +++ b/tests/service/SyntaxTreeTests/EnumCaseTests.fs @@ -12,7 +12,7 @@ type Foo = | Bar = 1 |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.Simple (simpleRepr = SynTypeDefnSimpleRepr.Enum(cases = [ @@ -36,7 +36,7 @@ type Foo = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.Simple (simpleRepr = SynTypeDefnSimpleRepr.Enum(cases = [ @@ -61,7 +61,7 @@ type Foo = Bar = 1 |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.Simple (simpleRepr = SynTypeDefnSimpleRepr.Enum(cases = [ diff --git a/tests/service/SyntaxTreeTests/ExceptionTests.fs b/tests/service/SyntaxTreeTests/ExceptionTests.fs index cd0ccef1cd1..a712eba5e6f 100644 --- a/tests/service/SyntaxTreeTests/ExceptionTests.fs +++ b/tests/service/SyntaxTreeTests/ExceptionTests.fs @@ -16,7 +16,7 @@ exception Foo with """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace(decls = [ SynModuleDecl.Exception( exnDefn=SynExceptionDefn(withKeyword = Some mWithKeyword) ) diff --git a/tests/service/SyntaxTreeTests/ExpressionTests.fs b/tests/service/SyntaxTreeTests/ExpressionTests.fs index eb18d053d6a..a7f1dcbb8df 100644 --- a/tests/service/SyntaxTreeTests/ExpressionTests.fs +++ b/tests/service/SyntaxTreeTests/ExpressionTests.fs @@ -16,7 +16,7 @@ let ``SynExpr.Do contains the range of the do keyword`` () = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [ SynBinding(expr = SynExpr.Sequential(expr1 = SynExpr.Do(_, doRange) ; expr2 = SynExpr.DoBang(_, doBangRange))) @@ -41,7 +41,7 @@ comp { |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.App(argExpr = SynExpr.ComputationExpr(expr = @@ -67,7 +67,7 @@ let ``SynExpr.Record contains the range of the equals sign in SynExprRecordField |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Record(recordFields = [ @@ -89,7 +89,7 @@ let ``inherit SynExpr.Record contains the range of the equals sign in SynExprRec |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Record(baseInfo = Some _ ; recordFields = [ @@ -112,7 +112,7 @@ let ``copy SynExpr.Record contains the range of the equals sign in SynExprRecord |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Record(copyInfo = Some _ ; recordFields = [ @@ -134,7 +134,7 @@ let ``SynExpr.AnonRecord contains the range of the equals sign in the fields`` ( |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.AnonRecd(recordFields = [ @@ -159,7 +159,7 @@ printf "%d " i |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.For(equalsRange = Some mEquals)) @@ -180,7 +180,7 @@ with |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.TryWith(trivia={ TryKeyword = mTry; WithKeyword = mWith })) @@ -202,7 +202,7 @@ finally |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.TryFinally(trivia={ TryKeyword = mTry; FinallyKeyword = mFinally })) @@ -222,7 +222,7 @@ match x with |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Match(trivia = { MatchKeyword = mMatch; WithKeyword = mWith })) @@ -242,7 +242,7 @@ match! x with |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.MatchBang(trivia = { MatchBangKeyword = mMatch; WithKeyword = mWith })) @@ -265,7 +265,7 @@ let ``SynExpr.ObjExpr contains the range of with keyword`` () = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.ObjExpr(withKeyword=Some mWithObjExpr; extraImpls=[ SynInterfaceImpl(withKeyword=None); SynInterfaceImpl(withKeyword=Some mWithSynInterfaceImpl) ])) @@ -281,7 +281,7 @@ let ``SynExpr.LetOrUse contains the range of in keyword`` () = getParseResults "let x = 1 in ()" match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.LetOrUse(trivia={ InKeyword = Some mIn })) @@ -301,7 +301,7 @@ do """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Do(expr = SynExpr.LetOrUse(bindings=[_;_]; trivia={ InKeyword = Some mIn }))) @@ -321,7 +321,7 @@ let f () = """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [ SynBinding(expr = @@ -343,7 +343,7 @@ let x = 1 """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Do(expr = SynExpr.LetOrUse(trivia={ InKeyword = None }))) @@ -362,7 +362,7 @@ e1.Key, e1.Value """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Do(expr = SynExpr.LetOrUse(trivia={ InKeyword = None }))) @@ -379,7 +379,7 @@ global """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.LongIdent(longDotId = SynLongIdent([mangledGlobal], [], [Some (IdentTrivia.OriginalNotation "global")])) @@ -400,7 +400,7 @@ let ``SynExprRecordFields contain correct amount of trivia`` () = """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Record(recordFields = [ @@ -420,7 +420,7 @@ let ``SynExpr.Dynamic does contain ident`` () = getParseResults "x?k" match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Dynamic (_, _, SynExpr.Ident(idK) ,mDynamicExpr)) ]) @@ -435,7 +435,7 @@ let ``SynExpr.Dynamic does contain parentheses`` () = getParseResults "x?(g)" match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Dynamic (_, _, SynExpr.Paren(SynExpr.Ident(idG), lpr, Some rpr, mParen) ,mDynamicExpr)) @@ -454,7 +454,7 @@ let ``SynExpr.Set with SynExpr.Dynamic`` () = getParseResults "x?v <- 2" match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Set( SynExpr.Dynamic (_, _, SynExpr.Ident(idV) ,mDynamicExpr), @@ -481,7 +481,7 @@ type CFoo() = """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types _ SynModuleDecl.Expr(expr = SynExpr.ObjExpr(members = [ diff --git a/tests/service/SyntaxTreeTests/IfThenElseTests.fs b/tests/service/SyntaxTreeTests/IfThenElseTests.fs index 7db54e4dfef..66cf9a82849 100644 --- a/tests/service/SyntaxTreeTests/IfThenElseTests.fs +++ b/tests/service/SyntaxTreeTests/IfThenElseTests.fs @@ -11,7 +11,7 @@ let ``If keyword in IfThenElse`` () = "if a then b" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.IfThenElse(trivia={ IfKeyword = mIfKw; IsElif = false; ThenKeyword = mThenKw; ElseKeyword = None }) ) @@ -27,7 +27,7 @@ let ``Else keyword in simple IfThenElse`` () = "if a then b else c" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr =SynExpr.IfThenElse(trivia={ IfKeyword = mIfKw; IsElif = false; ThenKeyword = mThenKw; ElseKeyword = Some mElse }) ) @@ -47,7 +47,7 @@ then b else c""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.IfThenElse(trivia={ IfKeyword = mIfKw; IsElif = false; ThenKeyword = mThenKw; ElseKeyword = Some mElse }) ) @@ -67,7 +67,7 @@ b elif c then d""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.IfThenElse(trivia={ IfKeyword = mIfKw; IsElif=false; ThenKeyword = mThenKw; ElseKeyword = None } elseExpr = Some (SynExpr.IfThenElse(trivia={ IfKeyword = mElif; IsElif = true }))) @@ -89,7 +89,7 @@ else if c then d""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.IfThenElse(trivia={ IfKeyword = mIfKw; IsElif = false; ThenKeyword = mThenKw; ElseKeyword = Some mElse } elseExpr = Some (SynExpr.IfThenElse(trivia={ IfKeyword = mElseIf; IsElif = false }))) @@ -112,7 +112,7 @@ else if c then d""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.IfThenElse(trivia={ IfKeyword = mIfKw; IsElif=false; ThenKeyword = mThenKw; ElseKeyword = Some mElse } elseExpr = Some (SynExpr.IfThenElse(trivia={ IfKeyword = mElseIf; IsElif = false }))) @@ -140,7 +140,7 @@ else g""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.IfThenElse(trivia={ IfKeyword = mIf1; IsElif = false; ElseKeyword = None } elseExpr = Some (SynExpr.IfThenElse(trivia={ IfKeyword = mElif; IsElif = true; ElseKeyword = Some mElse1 } @@ -165,7 +165,7 @@ else (* some long comment here *) if c then d""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.IfThenElse(trivia={ IfKeyword = mIf1; IsElif = false; ElseKeyword = Some mElse } elseExpr = Some (SynExpr.IfThenElse(trivia = { IfKeyword = mIf2; IsElif = false })))) diff --git a/tests/service/SyntaxTreeTests/LambdaTests.fs b/tests/service/SyntaxTreeTests/LambdaTests.fs index 788279f8e76..ebc343507ab 100644 --- a/tests/service/SyntaxTreeTests/LambdaTests.fs +++ b/tests/service/SyntaxTreeTests/LambdaTests.fs @@ -11,7 +11,7 @@ let ``Lambda with two parameters gives correct body`` () = "fun a b -> x" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Lambda(parsedData = Some([SynPat.Named _; SynPat.Named _], SynExpr.Ident ident)) ) @@ -26,7 +26,7 @@ let ``Lambda with wild card parameter gives correct body`` () = "fun a _ b -> x" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Lambda(parsedData = Some([SynPat.Named _; SynPat.Wild _; SynPat.Named _], SynExpr.Ident ident)) ) @@ -41,7 +41,7 @@ let ``Lambda with tuple parameter with wild card gives correct body`` () = "fun a (b, _) c -> x" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Lambda(parsedData = Some([SynPat.Named _; SynPat.Paren(SynPat.Tuple _,_); SynPat.Named _], SynExpr.Ident ident)) ) @@ -56,7 +56,7 @@ let ``Lambda with wild card that returns a lambda gives correct body`` () = "fun _ -> fun _ -> x" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Lambda(parsedData = Some([SynPat.Wild _], SynExpr.Lambda(parsedData = Some([SynPat.Wild _], SynExpr.Ident ident)))) ) @@ -71,7 +71,7 @@ let ``Simple lambda has arrow range`` () = "fun x -> x" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Lambda(trivia={ ArrowRange = Some mArrow }) ) @@ -88,7 +88,7 @@ let ``Multiline lambda has arrow range`` () = x * y * z" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Lambda(trivia={ ArrowRange = Some mArrow }) ) @@ -103,7 +103,7 @@ let ``Destructed lambda has arrow range`` () = "fun { X = x } -> x * 2" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Lambda(trivia={ ArrowRange = Some mArrow }) ) @@ -118,7 +118,7 @@ let ``Tuple in lambda has arrow range`` () = "fun (x, _) -> x * 3" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Lambda(trivia={ ArrowRange = Some mArrow }) ) @@ -137,7 +137,7 @@ let ``Complex arguments lambda has arrow range`` () = x * y + z" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Lambda(trivia={ ArrowRange = Some mArrow }) ) diff --git a/tests/service/SyntaxTreeTests/MatchClauseTests.fs b/tests/service/SyntaxTreeTests/MatchClauseTests.fs index caa6c5d6da5..5c68abb598a 100644 --- a/tests/service/SyntaxTreeTests/MatchClauseTests.fs +++ b/tests/service/SyntaxTreeTests/MatchClauseTests.fs @@ -17,7 +17,7 @@ with ex -> None""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.TryWith(withCases = [ SynMatchClause(range = range) as clause ])) ]) ])) -> assertRange (5, 5) (7, 8) range @@ -40,7 +40,7 @@ with None""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.TryWith(withCases = [ SynMatchClause(range = r1) as clause1 SynMatchClause(range = r2) as clause2 ])) ]) ])) -> @@ -65,7 +65,7 @@ with | """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.TryWith(withCases = [ SynMatchClause(range = range) as clause ])) ]) ])) -> assertRange (6, 2) (7, 6) range @@ -84,7 +84,7 @@ with | ex ->""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.TryWith(withCases = [ SynMatchClause(range = range) as clause ])) ]) ])) -> assertRange (6, 2) (6, 4) range @@ -103,7 +103,7 @@ with | ex when (isNull ex) ->""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.TryWith(withCases = [ SynMatchClause(range = range) as clause ])) ]) ])) -> assertRange (6, 2) (6, 21) range @@ -119,7 +119,7 @@ match foo with | Bar bar -> ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Match(clauses = [ SynMatchClause(trivia={ ArrowRange = Some mArrow }) ])) ]) ])) -> assertRange (3, 10) (3, 12) mArrow @@ -134,7 +134,7 @@ match foo with | Bar bar when (someCheck bar) -> ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Match(clauses = [ SynMatchClause(trivia={ ArrowRange = Some mArrow }) ])) ]) ])) -> assertRange (3, 31) (3, 33) mArrow @@ -149,7 +149,7 @@ match foo with | Bar bar when (someCheck bar) -> ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Match(clauses = [ SynMatchClause(trivia={ BarRange = Some mBar }) ])) ]) ])) -> assertRange (3, 0) (3, 1) mBar @@ -165,7 +165,7 @@ match foo with | Far too -> near ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Match(clauses = [ SynMatchClause(trivia={ BarRange = Some mBar1 }) SynMatchClause(trivia={ BarRange = Some mBar2 }) ])) ]) ])) -> @@ -184,7 +184,7 @@ with | exn -> ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.TryWith(withCases = [ SynMatchClause(trivia={ BarRange = Some mBar }) ])) ]) ])) -> assertRange (5, 0) (5, 1) mBar @@ -202,7 +202,7 @@ with exn -> ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.TryWith(withCases = [ SynMatchClause(trivia={ BarRange = None }) ])) ]) ])) -> Assert.Pass() @@ -222,7 +222,7 @@ with | ex -> ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.TryWith(withCases = [ SynMatchClause(trivia={ BarRange = Some mBar1 }) SynMatchClause(trivia={ BarRange = Some mBar2 }) ])) ]) ])) -> diff --git a/tests/service/SyntaxTreeTests/MeasureTests.fs b/tests/service/SyntaxTreeTests/MeasureTests.fs index 0e618693df9..f8c9f29271a 100644 --- a/tests/service/SyntaxTreeTests/MeasureTests.fs +++ b/tests/service/SyntaxTreeTests/MeasureTests.fs @@ -14,7 +14,7 @@ let m = 7.000 """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [ SynBinding.SynBinding(expr = SynExpr.Const(SynConst.Measure(constantRange = r1), _)) ]) SynModuleDecl.Let(bindings = [ SynBinding.SynBinding(expr = SynExpr.Const(SynConst.Measure(constantRange = r2), _)) ]) ]) ])) -> @@ -31,7 +31,7 @@ let ``SynMeasure.Paren has correct range`` () = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Const(SynConst.Measure(SynConst.UInt32 _, _, SynMeasure.Divide( SynMeasure.Seq([ SynMeasure.Named([ hrIdent ], _) ], _), @@ -62,7 +62,7 @@ let ``SynType.Tuple in measure type with no slashes`` () = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.Simple(simpleRepr = @@ -85,7 +85,7 @@ let ``SynType.Tuple in measure type with leading slash`` () = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.Simple(simpleRepr = @@ -107,7 +107,7 @@ let ``SynType.Tuple in measure type with start and slash`` () = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.Simple(simpleRepr = diff --git a/tests/service/SyntaxTreeTests/MemberFlagTests.fs b/tests/service/SyntaxTreeTests/MemberFlagTests.fs index b95d91bae9d..c29aad29300 100644 --- a/tests/service/SyntaxTreeTests/MemberFlagTests.fs +++ b/tests/service/SyntaxTreeTests/MemberFlagTests.fs @@ -22,7 +22,7 @@ type Y = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Types(types =[ SynTypeDefnSig(typeRepr=SynTypeDefnSigRepr.ObjectModel(memberSigs=[ SynMemberSig.Member(flags={ Trivia= { AbstractRange = Some mAbstract1 } }) @@ -56,7 +56,7 @@ type Foo = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.ObjectModel (members=[ @@ -85,7 +85,7 @@ type Foo = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.ObjectModel (members=[ @@ -124,7 +124,7 @@ type Foo = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.ObjectModel (members=[ @@ -158,7 +158,7 @@ let meh = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let (bindings = [ SynBinding(expr=SynExpr.ObjExpr( diff --git a/tests/service/SyntaxTreeTests/ModuleOrNamespaceSigTests.fs b/tests/service/SyntaxTreeTests/ModuleOrNamespaceSigTests.fs index bf9c025c36a..ec215cb41be 100644 --- a/tests/service/SyntaxTreeTests/ModuleOrNamespaceSigTests.fs +++ b/tests/service/SyntaxTreeTests/ModuleOrNamespaceSigTests.fs @@ -15,7 +15,7 @@ type Bar = | Bar of string * int """ match parseResults with - | ParsedInput.SigFile(ParsedSigFileInput(modules = [ + | ParsedInput.SigFile(ParsedSigFileInput(contents = [ SynModuleOrNamespaceSig(kind = SynModuleOrNamespaceKind.DeclaredNamespace) as singleModule ])) -> assertRange (2,0) (4,32) singleModule.Range @@ -33,7 +33,7 @@ type Bar = | Bar of string * int """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(kind = SynModuleOrNamespaceKind.GlobalNamespace; range = r) ])) -> assertRange (3, 0) (5, 32) r | _ -> Assert.Fail "Could not get valid AST" @@ -50,7 +50,7 @@ val s : string """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig.SynModuleOrNamespaceSig(kind = SynModuleOrNamespaceKind.NamedModule; range = r) ])) -> assertRange (2, 1) (5, 14) r | _ -> Assert.Fail "Could not get valid AST" @@ -66,7 +66,7 @@ val a: int """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(kind = SynModuleOrNamespaceKind.NamedModule; trivia = { ModuleKeyword = Some mModule; NamespaceKeyword = None }) ])) -> assertRange (2, 0) (2, 6) mModule | _ -> Assert.Fail "Could not get valid AST" @@ -82,7 +82,7 @@ val a: int """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(kind = SynModuleOrNamespaceKind.DeclaredNamespace; trivia = { ModuleKeyword = None; NamespaceKeyword = Some mNamespace }) ])) -> assertRange (2, 0) (2, 9) mNamespace | _ -> Assert.Fail "Could not get valid AST" \ No newline at end of file diff --git a/tests/service/SyntaxTreeTests/ModuleOrNamespaceTests.fs b/tests/service/SyntaxTreeTests/ModuleOrNamespaceTests.fs index 8091c0942d6..fcba2811028 100644 --- a/tests/service/SyntaxTreeTests/ModuleOrNamespaceTests.fs +++ b/tests/service/SyntaxTreeTests/ModuleOrNamespaceTests.fs @@ -16,7 +16,7 @@ type Teq<'a, 'b> """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(kind = SynModuleOrNamespaceKind.DeclaredNamespace; range = r) ])) -> + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(kind = SynModuleOrNamespaceKind.DeclaredNamespace; range = r) ])) -> assertRange (1, 0) (4, 8) r | _ -> Assert.Fail "Could not get valid AST" @@ -35,7 +35,7 @@ let x = 42 """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(kind = SynModuleOrNamespaceKind.DeclaredNamespace; range = r1) SynModuleOrNamespace.SynModuleOrNamespace(kind = SynModuleOrNamespaceKind.DeclaredNamespace; range = r2) ])) -> assertRange (1, 0) (4, 20) r1 @@ -54,7 +54,7 @@ type X = int """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(kind = SynModuleOrNamespaceKind.GlobalNamespace; range = r) ])) -> assertRange (3, 0) (5, 12) r | _ -> Assert.Fail "Could not get valid AST" @@ -71,7 +71,7 @@ let s : string = "s" """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(kind = SynModuleOrNamespaceKind.NamedModule; range = r) ])) -> assertRange (2, 0) (5, 20) r | _ -> Assert.Fail "Could not get valid AST" @@ -96,7 +96,7 @@ let a = 42 """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(kind = SynModuleOrNamespaceKind.NamedModule; trivia = { ModuleKeyword = Some mModule; NamespaceKeyword = None }) ])) -> assertRange (5, 0) (5, 6) mModule | _ -> Assert.Fail "Could not get valid AST" @@ -112,7 +112,7 @@ let a = 42 """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(kind = SynModuleOrNamespaceKind.DeclaredNamespace; trivia = { ModuleKeyword = None; NamespaceKeyword = Some mNamespace }) ])) -> assertRange (2, 0) (2, 9) mNamespace | _ -> Assert.Fail $"Could not get valid AST, got {parseResults}" @@ -128,7 +128,7 @@ open global.Node """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Open(target = SynOpenDeclTarget.ModuleOrNamespace(longId = SynLongIdent(trivia = [ Some (IdentTrivia.OriginalNotation("global")); None ]))) ]) ])) -> diff --git a/tests/service/SyntaxTreeTests/NestedModuleTests.fs b/tests/service/SyntaxTreeTests/NestedModuleTests.fs index d6dcac70f76..fcdde98008a 100644 --- a/tests/service/SyntaxTreeTests/NestedModuleTests.fs +++ b/tests/service/SyntaxTreeTests/NestedModuleTests.fs @@ -18,7 +18,7 @@ module Nested = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.NestedModule _ as nm ]) as sigModule ])) -> assertRange (4, 0) (6, 15) nm.Range @@ -37,7 +37,7 @@ module Nested = ()""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.NestedModule _ as nm ]) ])) -> assertRange (4, 0) (6, 6) nm.Range @@ -53,7 +53,7 @@ module X = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.NestedModule(trivia = { ModuleKeyword = Some mModule; EqualsRange = Some mEquals }) ]) ])) -> assertRange (2, 0) (2, 6) mModule @@ -72,7 +72,7 @@ val bar : int """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.NestedModule(trivia = { ModuleKeyword = Some mModule; EqualsRange = Some mEquals }) ]) ])) -> assertRange (4, 0) (4, 6) mModule @@ -146,7 +146,7 @@ module Operators = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Open _ SynModuleSigDecl.Open _ SynModuleSigDecl.Open _ diff --git a/tests/service/SyntaxTreeTests/OperatorNameTests.fs b/tests/service/SyntaxTreeTests/OperatorNameTests.fs index ce64e19b85e..9efbb4dc972 100644 --- a/tests/service/SyntaxTreeTests/OperatorNameTests.fs +++ b/tests/service/SyntaxTreeTests/OperatorNameTests.fs @@ -13,7 +13,7 @@ let ``operator as function`` () = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr (expr = SynExpr.App(funcExpr = SynExpr.App(funcExpr = SynExpr.LongIdent(longDotId = SynLongIdent([ident], _, [Some (IdentTrivia.OriginalNotationWithParen(lpr, "+", rpr))]))))) @@ -33,7 +33,7 @@ let ``active pattern as function `` () = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr (expr = SynExpr.App(funcExpr = SynExpr.LongIdent(false, SynLongIdent([ ident ], _, [ Some(IdentTrivia.HasParenthesis(lpr, rpr)) ]), None, pr))) @@ -54,7 +54,7 @@ let ``partial active pattern as function `` () = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr (expr = SynExpr.App(funcExpr = SynExpr.LongIdent(false, SynLongIdent([ ident ], _, [ Some(IdentTrivia.HasParenthesis(lpr, rpr)) ]), None, pr))) @@ -75,7 +75,7 @@ let (+) a b = a + b |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(headPat= SynPat.LongIdent(longDotId = SynLongIdent([ ident ],_, [ Some (IdentTrivia.OriginalNotationWithParen(lpr, "+", rpr)) ]))) @@ -95,7 +95,7 @@ let (|Odd|Even|) (a: int) = if a % 2 = 0 then Even else Odd |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(headPat= SynPat.LongIdent(longDotId = SynLongIdent([ident], _, [Some (IdentTrivia.HasParenthesis(lpr, rpr))]))) @@ -115,7 +115,7 @@ let (|Int32Const|_|) (a: SynConst) = match a with SynConst.Int32 _ -> Some a | _ |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(headPat= SynPat.LongIdent(longDotId = SynLongIdent([ident], _, [Some (IdentTrivia.HasParenthesis(lpr, rpr))]))) @@ -135,7 +135,7 @@ let (|Boolean|_|) = Boolean.parse |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(headPat= SynPat.Named(ident = SynIdent(ident, Some (IdentTrivia.HasParenthesis(lpr, rpr))))) @@ -157,7 +157,7 @@ val (&): e1: bool -> e2: bool -> bool |> getParseResultsOfSignatureFile match ast with - | ParsedInput.SigFile(ParsedSigFileInput(modules = [ + | ParsedInput.SigFile(ParsedSigFileInput(contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Val(valSig = SynValSig(ident = SynIdent(ident, Some (IdentTrivia.OriginalNotationWithParen(lpr, "&", rpr))) ))]) @@ -186,7 +186,7 @@ let ``operator name in val constraint`` () = """ match ast with - | ParsedInput.SigFile(ParsedSigFileInput(modules = [ + | ParsedInput.SigFile(ParsedSigFileInput(contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Val(valSig = SynValSig(synType=SynType.WithGlobalConstraints(constraints=[ SynTypeConstraint.WhereTyparSupportsMember(memberSig=SynMemberSig.Member(memberSig=SynValSig(ident = @@ -208,7 +208,7 @@ f(x=4) """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.App(argExpr = SynExpr.Paren(expr = SynExpr.App(funcExpr= SynExpr.App(funcExpr= SynExpr.LongIdent(longDotId = SynLongIdent([ident], _, [Some (IdentTrivia.OriginalNotation "=")]))))))) @@ -226,7 +226,7 @@ let ``infix operation`` () = """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.App(funcExpr = SynExpr.App(isInfix = true @@ -247,7 +247,7 @@ let ``prefix operation`` () = """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.App(isInfix = false @@ -267,7 +267,7 @@ let ``prefix operation with two characters`` () = """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.App(isInfix = false @@ -289,7 +289,7 @@ op_Addition a b """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.App(funcExpr = SynExpr.App(isInfix = false @@ -324,7 +324,7 @@ type X with """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn(members = [ @@ -350,7 +350,7 @@ nameof(+) """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.App(isInfix = false @@ -375,7 +375,7 @@ f(?x = 7) """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.App(isInfix = false @@ -408,7 +408,7 @@ type X() = """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn.SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members =[ @@ -437,7 +437,7 @@ let PowByte (x:byte) n = Checked.( * ) x """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [ SynBinding(expr = SynExpr.App(funcExpr = @@ -465,7 +465,7 @@ type A() = """ match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [ diff --git a/tests/service/SyntaxTreeTests/ParsedHashDirectiveTests.fs b/tests/service/SyntaxTreeTests/ParsedHashDirectiveTests.fs index d59587c6b36..f834680fdff 100644 --- a/tests/service/SyntaxTreeTests/ParsedHashDirectiveTests.fs +++ b/tests/service/SyntaxTreeTests/ParsedHashDirectiveTests.fs @@ -11,7 +11,7 @@ let ``SourceIdentifier as ParsedHashDirectiveArgument`` () = "#I __SOURCE_DIRECTORY__" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.HashDirective(ParsedHashDirective("I", [ ParsedHashDirectiveArgument.SourceIdentifier(c,_,m) ] , _), _) ]) ])) -> Assert.AreEqual("__SOURCE_DIRECTORY__", c) @@ -25,7 +25,7 @@ let ``Regular String as ParsedHashDirectiveArgument`` () = "#I \"/tmp\"" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.HashDirective(ParsedHashDirective("I", [ ParsedHashDirectiveArgument.String(v, SynStringKind.Regular, m) ] , _), _) ]) ])) -> Assert.AreEqual("/tmp", v) @@ -39,7 +39,7 @@ let ``Verbatim String as ParsedHashDirectiveArgument`` () = "#I @\"C:\\Temp\"" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.HashDirective(ParsedHashDirective("I", [ ParsedHashDirectiveArgument.String(v, SynStringKind.Verbatim, m) ] , _), _) ]) ])) -> Assert.AreEqual("C:\\Temp", v) @@ -53,7 +53,7 @@ let ``Triple quote String as ParsedHashDirectiveArgument`` () = "#nowarn \"\"\"40\"\"\"" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.HashDirective(ParsedHashDirective("nowarn", [ ParsedHashDirectiveArgument.String(v, SynStringKind.TripleQuote, m) ] , _), _) ]) ])) -> Assert.AreEqual("40", v) diff --git a/tests/service/SyntaxTreeTests/PatternTests.fs b/tests/service/SyntaxTreeTests/PatternTests.fs index 42905ec976f..61a511dc88a 100644 --- a/tests/service/SyntaxTreeTests/PatternTests.fs +++ b/tests/service/SyntaxTreeTests/PatternTests.fs @@ -16,7 +16,7 @@ match x with """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Match(clauses = [ SynMatchClause(pat = SynPat.Record(fieldPats = [ (_, mEquals, _) ])) ; _ ]) ) @@ -34,7 +34,7 @@ match x with """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Match(clauses = [ SynMatchClause(pat = SynPat.LongIdent(argPats = SynArgPats.NamePatPairs(pats = [ _, mEquals ,_ ])))]) ) @@ -54,7 +54,7 @@ match x with """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Match(clauses = [ SynMatchClause(pat = SynPat.Or(trivia={ BarRange = mBar })) ; _ ]) ) @@ -71,7 +71,7 @@ let (head::tail) = [ 1;2;4] """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let( bindings = [ SynBinding(headPat = SynPat.Paren(SynPat.LongIdent(longDotId = SynLongIdent([ opColonColonIdent ], _, [ Some (IdentTrivia.OriginalNotation "::") ])), _)) ] ) @@ -89,7 +89,7 @@ match x with """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr( expr = SynExpr.Match(clauses = [ SynMatchClause(pat = SynPat.LongIdent(longDotId = SynLongIdent([ opColonColonIdent ], _, [ Some (IdentTrivia.OriginalNotation "::") ]))) diff --git a/tests/service/SyntaxTreeTests/SignatureTypeTests.fs b/tests/service/SyntaxTreeTests/SignatureTypeTests.fs index e7f8055fee9..b90439bd0ac 100644 --- a/tests/service/SyntaxTreeTests/SignatureTypeTests.fs +++ b/tests/service/SyntaxTreeTests/SignatureTypeTests.fs @@ -18,7 +18,7 @@ type Meh = // foo""" match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types(range = r)]) ])) -> assertRange (3, 0) (5,11) r | _ -> Assert.Fail "Could not get valid AST" @@ -33,7 +33,7 @@ type MyRecord = member Score : unit -> int""" match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes)]) ])) -> assertRange (2, 0) (4, 30) mTypes assertRange (2, 5) (4, 30) mSynTypeDefnSig @@ -50,7 +50,7 @@ type MyRecord = member Score : unit -> int""" match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes)]) ])) -> assertRange (2, 0) (5, 30) mTypes assertRange (2, 5) (5, 30) mSynTypeDefnSig @@ -65,7 +65,7 @@ type MyFunction = delegate of int -> string""" match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes) ]) ])) -> assertRange (2, 0) (3, 29) mTypes assertRange (2, 5) (3, 29) mSynTypeDefnSig @@ -81,7 +81,7 @@ type SomeCollection with val SomeThingElse : int -> string""" match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes)]) ])) -> assertRange (2, 0) (4, 37) mTypes assertRange (2, 5) (4, 37) mSynTypeDefnSig @@ -101,7 +101,7 @@ type MyType = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types(types = [SynTypeDefnSig.SynTypeDefnSig(range = r)]) as t]) ])) -> assertRange (4, 0) (7, 7) r assertRange (4, 0) (7, 7) t.Range @@ -126,7 +126,7 @@ and [] Bang = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types([ SynTypeDefnSig.SynTypeDefnSig(range = r1) SynTypeDefnSig.SynTypeDefnSig(range = r2) @@ -149,7 +149,7 @@ type FooType = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Types(types = [ SynTypeDefnSig.SynTypeDefnSig(typeRepr = @@ -171,7 +171,7 @@ type X = delegate of string -> string """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Types( types = [ SynTypeDefnSig(trivia = { EqualsRange = Some mEquals } typeRepr = SynTypeDefnSigRepr.ObjectModel(kind = SynTypeDefnKind.Delegate _)) ] @@ -193,7 +193,7 @@ type Foobar = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Types( types = [ SynTypeDefnSig(trivia = { EqualsRange = Some mEquals } typeRepr = SynTypeDefnSigRepr.ObjectModel(kind = SynTypeDefnKind.Class)) ] @@ -215,7 +215,7 @@ type Bear = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Types( types = [ SynTypeDefnSig(trivia = { EqualsRange = Some mEquals } typeRepr = SynTypeDefnSigRepr.Simple(repr = @@ -243,7 +243,7 @@ type Shape = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Types( types = [ SynTypeDefnSig(trivia = { EqualsRange = Some mEquals } typeRepr = SynTypeDefnSigRepr.Simple(repr = SynTypeDefnSimpleRepr.Union _)) ] @@ -264,7 +264,7 @@ member Meh : unit -> unit """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules =[ SynModuleOrNamespaceSig(decls =[ + | ParsedInput.SigFile (ParsedSigFileInput (contents =[ SynModuleOrNamespaceSig(decls =[ SynModuleSigDecl.Types( types=[ SynTypeDefnSig(typeRepr=SynTypeDefnSigRepr.Simple _ trivia = { WithKeyword = Some mWithKeyword }) ] @@ -285,7 +285,7 @@ member Meh : unit -> unit """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Exception( exnSig=SynExceptionSig(withKeyword = Some mWithKeyword) ) @@ -305,7 +305,7 @@ type Foo = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules = [ SynModuleOrNamespaceSig(decls = [ + | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Types( types=[ SynTypeDefnSig(typeRepr=SynTypeDefnSigRepr.ObjectModel(memberSigs=[SynMemberSig.Member(memberSig=SynValSig(trivia = { WithKeyword = Some mWithKeyword }))])) ] ) @@ -328,7 +328,7 @@ exception SyntaxError of obj * range: range """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules=[ + | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ SynModuleSigDecl.Exception( SynExceptionSig(exnRepr=SynExceptionDefnRepr(range=mSynExceptionDefnRepr); range=mSynExceptionSig), mException) @@ -352,7 +352,7 @@ open Foo """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules=[ + | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ SynModuleSigDecl.Exception( SynExceptionSig(exnRepr=SynExceptionDefnRepr(range=mSynExceptionDefnRepr); range=mSynExceptionSig), mException) @@ -376,7 +376,7 @@ val a : int """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules=[ + | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ SynModuleSigDecl.Val(valSig = SynValSig(trivia = { ValKeyword = Some mVal })) ] ) ])) -> @@ -394,7 +394,7 @@ val a : int = 9 """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules=[ + | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ SynModuleSigDecl.Val(valSig = SynValSig(trivia = { EqualsRange = Some mEquals }); range = mVal) ] ) ])) -> @@ -414,7 +414,7 @@ type X = """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules=[ + | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ SynModuleSigDecl.Types(types = [ SynTypeDefnSig(typeRepr = SynTypeDefnSigRepr.ObjectModel(memberSigs = [ @@ -448,7 +448,7 @@ type Z with """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules=[ + | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ SynModuleSigDecl.Types(types = [ SynTypeDefnSig(trivia = { TypeKeyword = Some mType1 diff --git a/tests/service/SyntaxTreeTests/SourceIdentifierTests.fs b/tests/service/SyntaxTreeTests/SourceIdentifierTests.fs index 190f2664574..f7d96c3a7ea 100644 --- a/tests/service/SyntaxTreeTests/SourceIdentifierTests.fs +++ b/tests/service/SyntaxTreeTests/SourceIdentifierTests.fs @@ -13,7 +13,7 @@ let ``__LINE__`` () = __LINE__""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Const(SynConst.SourceIdentifier("__LINE__", "2", range), _)) ]) ])) -> assertRange (2, 0) (2, 8) range @@ -27,7 +27,7 @@ let ``__SOURCE_DIRECTORY__`` () = __SOURCE_DIRECTORY__""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Const(SynConst.SourceIdentifier("__SOURCE_DIRECTORY__", _, range), _)) ]) ])) -> assertRange (2, 0) (2, 20) range @@ -41,7 +41,7 @@ let ``__SOURCE_FILE__`` () = __SOURCE_FILE__""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.Const(SynConst.SourceIdentifier("__SOURCE_FILE__", _, range), _)) ]) ])) -> assertRange (2, 0) (2, 15) range diff --git a/tests/service/SyntaxTreeTests/StringTests.fs b/tests/service/SyntaxTreeTests/StringTests.fs index d75384d8f60..c562b2450a6 100644 --- a/tests/service/SyntaxTreeTests/StringTests.fs +++ b/tests/service/SyntaxTreeTests/StringTests.fs @@ -7,7 +7,7 @@ open FsUnit let private getBindingExpressionValue (parseResults: ParsedInput) = match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = modules)) -> + | ParsedInput.ImplFile (ParsedImplFileInput (contents = modules)) -> modules |> List.tryPick (fun (SynModuleOrNamespace (decls = decls)) -> decls |> List.tryPick (fun decl -> match decl with diff --git a/tests/service/SyntaxTreeTests/TypeTests.fs b/tests/service/SyntaxTreeTests/TypeTests.fs index 0c822ea94dc..ef8aa1aa901 100644 --- a/tests/service/SyntaxTreeTests/TypeTests.fs +++ b/tests/service/SyntaxTreeTests/TypeTests.fs @@ -14,7 +14,7 @@ type Foo = One = 0x00000001 """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn.SynTypeDefn(typeRepr = SynTypeDefnRepr.Simple(simpleRepr = SynTypeDefnSimpleRepr.Enum(cases = [ SynEnumCase.SynEnumCase(valueRange = r) ])))]) @@ -33,7 +33,7 @@ type Foo = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn.SynTypeDefn(typeRepr = SynTypeDefnRepr.Simple(simpleRepr = SynTypeDefnSimpleRepr.Enum(cases = [ SynEnumCase.SynEnumCase(valueRange = r1) @@ -54,7 +54,7 @@ type Bar = end""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [t]) as types ]) ])) -> assertRange (2, 0) (5, 7) types.Range @@ -77,7 +77,7 @@ and [] Bar<'context, 'a> = }""" match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [t1;t2]) as types ]) ])) -> assertRange (2, 0) (10, 5) types.Range @@ -94,7 +94,7 @@ type X = delegate of string -> string """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(kind = SynTypeDefnKind.Delegate _) trivia={ EqualsRange = Some mEquals }) ] @@ -114,7 +114,7 @@ type Foobar () = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(kind = SynTypeDefnKind.Class) trivia={ EqualsRange = Some mEquals }) ] @@ -134,7 +134,7 @@ type Bear = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.Simple(simpleRepr = SynTypeDefnSimpleRepr.Enum(cases = [ @@ -160,7 +160,7 @@ type Shape = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.Simple(simpleRepr = SynTypeDefnSimpleRepr.Union _) trivia={ EqualsRange = Some mEquals }) ] @@ -181,7 +181,7 @@ type Person(name : string, age : int) = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [_ ; SynMemberDefn.AutoProperty(equalsRange = mEquals)])) ] ) @@ -201,7 +201,7 @@ type Foo = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr=SynTypeDefnRepr.Simple(simpleRepr= SynTypeDefnSimpleRepr.Record _) trivia={ WithKeyword = Some mWithKeyword }) ] @@ -220,7 +220,7 @@ type Int32 with """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(kind=SynTypeDefnKind.Augmentation mWithKeyword)) ] ) @@ -240,7 +240,7 @@ type Foo() = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members=[ SynMemberDefn.ImplicitCtor _ SynMemberDefn.Interface(withKeyword=Some mWithKeyword) @@ -261,7 +261,7 @@ type Foo() = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [_ SynMemberDefn.AutoProperty(withKeyword=Some mWith) @@ -281,7 +281,7 @@ type Foo() = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [_ SynMemberDefn.AbstractSlot(slotSig=SynValSig(trivia = { WithKeyword = Some mWith }))])) ] @@ -301,7 +301,7 @@ type Foo() = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members=[ @@ -323,7 +323,7 @@ type Foo() = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members=[ @@ -347,7 +347,7 @@ type Foo() = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members=[ @@ -371,7 +371,7 @@ and C = D """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(trivia={ TypeKeyword = Some mType }) SynTypeDefn(trivia={ TypeKeyword = None }) ] @@ -391,7 +391,7 @@ type A = B """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(trivia={ TypeKeyword = Some mType }) ] ) @@ -411,7 +411,7 @@ type Foo = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [ SynMemberDefn.GetSetMember(Some _, Some _, m, { WithKeyword = mWith @@ -438,7 +438,7 @@ type A() = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ + | ParsedInput.ImplFile (ParsedImplFileInput (contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types( typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(members = [ SynMemberDefn.ImplicitCtor _ @@ -473,7 +473,7 @@ let ``SynType.Fun has range of arrow`` () = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.Simple(simpleRepr = diff --git a/tests/service/SyntaxTreeTests/UnionCaseTests.fs b/tests/service/SyntaxTreeTests/UnionCaseTests.fs index c9c480cc16e..29fc350cc0b 100644 --- a/tests/service/SyntaxTreeTests/UnionCaseTests.fs +++ b/tests/service/SyntaxTreeTests/UnionCaseTests.fs @@ -19,7 +19,7 @@ type Foo = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.Simple (simpleRepr = SynTypeDefnSimpleRepr.Union(unionCases = [ @@ -50,7 +50,7 @@ type Foo = | Bar of string |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.Simple (simpleRepr = SynTypeDefnSimpleRepr.Union(unionCases = [ @@ -73,7 +73,7 @@ type Foo = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.Simple (simpleRepr = SynTypeDefnSimpleRepr.Union(unionCases = [ @@ -96,7 +96,7 @@ type Foo = Bar of string |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.Simple (simpleRepr = SynTypeDefnSimpleRepr.Union(unionCases = [ @@ -124,7 +124,7 @@ type Currency = |> getParseResults match ast with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.Simple (simpleRepr = SynTypeDefnSimpleRepr.Union( diff --git a/tests/service/XmlDocTests.fs b/tests/service/XmlDocTests.fs index 76bce785065..cb0266e55ff 100644 --- a/tests/service/XmlDocTests.fs +++ b/tests/service/XmlDocTests.fs @@ -17,12 +17,12 @@ open FsUnit open NUnit.Framework let (|Types|TypeSigs|) = function - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(range = range; typeDefns = types)])])) -> Types(range, types) - | ParsedInput.SigFile(ParsedSigFileInput(modules = [ + | ParsedInput.SigFile(ParsedSigFileInput(contents = [ SynModuleOrNamespaceSig.SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Types(range = range; types = types)])])) -> TypeSigs(range, types) @@ -38,34 +38,34 @@ let (|TypeSigRange|) = function typeRange, componentInfoRange let (|Module|NestedModules|NestedModulesSigs|) = function - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.NestedModule(range = range1) SynModuleDecl.NestedModule(range = range2)])])) -> NestedModules(range1, range2) - | ParsedInput.SigFile(ParsedSigFileInput(modules = [ + | ParsedInput.SigFile(ParsedSigFileInput(contents = [ SynModuleOrNamespaceSig.SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.NestedModule(range = range1) SynModuleSigDecl.NestedModule(range = range2)])])) -> NestedModulesSigs(range1, range2) - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(range = range)])) - | ParsedInput.SigFile(ParsedSigFileInput(modules = [ + | ParsedInput.SigFile(ParsedSigFileInput(contents = [ SynModuleOrNamespaceSig.SynModuleOrNamespaceSig(range = range)])) -> Module(range) | x -> failwith $"Unexpected ParsedInput %A{x}" let (|Exception|) = function - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Exception(range = range; exnDefn = SynExceptionDefn(range = exnDefnRange; exnRepr = SynExceptionDefnRepr(range = exnDefnReprRange)))])])) -> Exception(range, exnDefnRange, exnDefnReprRange) - | ParsedInput.SigFile(ParsedSigFileInput(modules = [ + | ParsedInput.SigFile(ParsedSigFileInput(contents = [ SynModuleOrNamespaceSig.SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Exception(range = range; exnSig = SynExceptionSig(range = exnSpfnRange; exnRepr = @@ -99,26 +99,26 @@ let (|Members|MemberSigs|) = function | x -> failwith $"Unexpected ParsedInput %A{x}" let (|Decls|LetBindings|ValSig|LetOrUse|) = function - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [SynBinding(expr = SynExpr.LetOrUse(range = range; bindings = bindings))])])])) -> LetOrUse(range, bindings) - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(range = range; bindings = bindings)])])) -> LetBindings(range, bindings) - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Expr(expr = SynExpr.LetOrUse(range = range; bindings = bindings))])])) -> LetBindings(range, bindings) - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = decls)])) -> Decls(decls) - | ParsedInput.SigFile(ParsedSigFileInput(modules = [ + | ParsedInput.SigFile(ParsedSigFileInput(contents = [ SynModuleOrNamespaceSig.SynModuleOrNamespaceSig(decls = [ SynModuleSigDecl.Val(valSig = SynValSig(range = valSigRange); range = range)])])) -> ValSig(range, valSigRange) @@ -1374,8 +1374,8 @@ namespace N checkParsingErrors [|Information 3520, Line 2, Col 0, Line 2, Col 4, "XML comment is not placed on a valid language element."|] match parseResults.ParseTree with - | ParsedInput.ImplFile(ParsedImplFileInput(modules = [SynModuleOrNamespace.SynModuleOrNamespace(range = range)])) - | ParsedInput.SigFile(ParsedSigFileInput(modules = [SynModuleOrNamespaceSig.SynModuleOrNamespaceSig(range = range)])) -> + | ParsedInput.ImplFile(ParsedImplFileInput(contents = [SynModuleOrNamespace.SynModuleOrNamespace(range = range)])) + | ParsedInput.SigFile(ParsedSigFileInput(contents = [SynModuleOrNamespaceSig.SynModuleOrNamespaceSig(range = range)])) -> assertRange (3, 0) (3, 11) range | x -> failwith $"Unexpected ParsedInput %A{x}") From 90a60f80952a17451521f6c098dc13c55f33d72a Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 23 Aug 2022 15:04:36 +0100 Subject: [PATCH 04/33] code formatting --- src/Compiler/Driver/ParseAndCheckInputs.fs | 49 ++++++++++++++++---- src/Compiler/Service/ServiceParseTreeWalk.fs | 1 + src/Compiler/Service/ServiceXmlDocParser.fs | 3 +- src/Compiler/SyntaxTree/SyntaxTree.fs | 21 ++++++--- src/Compiler/SyntaxTree/SyntaxTree.fsi | 1 - 5 files changed, 55 insertions(+), 20 deletions(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index b350e9dbb7b..1e27e97bc24 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -506,10 +506,8 @@ let ReportParsingStatistics res = let flattenModImpl (SynModuleOrNamespace (decls = decls)) = flattenDefns decls match res with - | ParsedInput.SigFile sigFile -> - printfn "parsing yielded %d specs" (List.collect flattenModSpec sigFile.Contents).Length - | ParsedInput.ImplFile implFile -> - printfn "parsing yielded %d definitions" (List.collect flattenModImpl implFile.Contents).Length + | ParsedInput.SigFile sigFile -> printfn "parsing yielded %d specs" (List.collect flattenModSpec sigFile.Contents).Length + | ParsedInput.ImplFile implFile -> printfn "parsing yielded %d definitions" (List.collect flattenModImpl implFile.Contents).Length let EmptyParsedInput (fileName, isLastCompiland) = if FSharpSigFileSuffixes |> List.exists (FileSystemUtils.checkSuffix fileName) then @@ -1233,7 +1231,17 @@ let AddCheckResultsToTcState ccuSigForFile, tcState -let AddDummyCheckResultsToTcState (tcGlobals, amap, qualName: QualifiedNameOfFile, prefixPathOpt, tcSink, tcState: TcState, tcStateForImplFile: TcState, rootSig) = +let AddDummyCheckResultsToTcState + ( + tcGlobals, + amap, + qualName: QualifiedNameOfFile, + prefixPathOpt, + tcSink, + tcState: TcState, + tcStateForImplFile: TcState, + rootSig + ) = let hadSig = true let emptyImplFile = CreateEmptyDummyImplFile qualName rootSig let tcEnvAtEnd = tcStateForImplFile.TcEnvFromImpls @@ -1345,7 +1353,8 @@ let CheckOneInputAux let tcStateForImplFile = tcState let qualNameOfFile = file.QualifiedName let hadSig = true - let priorErrors = checkForErrors() + let priorErrors = checkForErrors () + let ccuSigForFile, tcState = AddCheckResultsToTcState (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, rootSig) @@ -1412,7 +1421,17 @@ let CheckOneInput match partialResult with | Choice1Of2 result -> return result, tcState | Choice2Of2 (amap, _conditionalDefines, rootSig, _priorErrors, file, tcStateForImplFile, _ccuSigForFile) -> - return AddDummyCheckResultsToTcState(tcGlobals, amap, file.QualifiedName, prefixPathOpt, tcSink, tcState, tcStateForImplFile, rootSig) + return + AddDummyCheckResultsToTcState( + tcGlobals, + amap, + file.QualifiedName, + prefixPathOpt, + tcSink, + tcState, + tcStateForImplFile, + rootSig + ) } // Within a file, equip loggers to locally filter w.r.t. scope pragmas in each input @@ -1501,7 +1520,7 @@ let CheckMultipleInputsInParallel // In the first linear part of parallel checking, we use a 'checkForErrors' that checks either for errors // somewhere in the files processed prior to each one, or in the processing of this particular file. - let priorErrors = checkForErrors() + let priorErrors = checkForErrors () // Do the first linear phase, checking all signatures and any implementation files that don't have a signature. // Implementation files that do have a signature will result in a Choice2Of2 indicating to next do some of the @@ -1514,10 +1533,20 @@ let CheckMultipleInputsInParallel let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0) let partialResult, tcState = - CheckOneInputAux(checkForErrors2, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, input, true) + CheckOneInputAux( + checkForErrors2, + tcConfig, + tcImports, + tcGlobals, + prefixPathOpt, + TcResultsSink.NoSink, + tcState, + input, + true + ) |> Cancellable.runWithoutCancellation - let priorErrors = checkForErrors2() + let priorErrors = checkForErrors2 () partialResult, (tcState, priorErrors)) // Do the parallel phase, checking all implementation files that did have a signature, in parallel. diff --git a/src/Compiler/Service/ServiceParseTreeWalk.fs b/src/Compiler/Service/ServiceParseTreeWalk.fs index 5e36b71fca5..08c89d969f9 100755 --- a/src/Compiler/Service/ServiceParseTreeWalk.fs +++ b/src/Compiler/Service/ServiceParseTreeWalk.fs @@ -975,6 +975,7 @@ module SyntaxTraversal = match parseTree with | ParsedInput.ImplFile file -> let l = file.Contents + let fileRange = #if DEBUG match l with diff --git a/src/Compiler/Service/ServiceXmlDocParser.fs b/src/Compiler/Service/ServiceXmlDocParser.fs index ce509056cb1..ae9217e8a02 100644 --- a/src/Compiler/Service/ServiceXmlDocParser.fs +++ b/src/Compiler/Service/ServiceXmlDocParser.fs @@ -210,8 +210,7 @@ module XmlDocParsing = and getXmlDocablesInput input = match input with - | ParsedInput.ImplFile file -> - file.Contents |> List.collect getXmlDocablesSynModuleOrNamespace + | ParsedInput.ImplFile file -> file.Contents |> List.collect getXmlDocablesSynModuleOrNamespace | ParsedInput.SigFile _ -> [] // Get compiler options for the 'project' implied by a single script file diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fs b/src/Compiler/SyntaxTree/SyntaxTree.fs index 977f63da92d..40fc5852cf7 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fs +++ b/src/Compiler/SyntaxTree/SyntaxTree.fs @@ -1680,11 +1680,14 @@ type ParsedImplFileInput = flags: (bool * bool) * trivia: ParsedImplFileInputTrivia - member x.QualifiedName = (let (ParsedImplFileInput (qualifiedNameOfFile = qualNameOfFile)) = x in qualNameOfFile) + member x.QualifiedName = + (let (ParsedImplFileInput (qualifiedNameOfFile = qualNameOfFile)) = x in qualNameOfFile) - member x.ScopedPragmas = (let (ParsedImplFileInput (scopedPragmas = scopedPragmas)) = x in scopedPragmas) + member x.ScopedPragmas = + (let (ParsedImplFileInput (scopedPragmas = scopedPragmas)) = x in scopedPragmas) - member x.HashDirectives = (let (ParsedImplFileInput (hashDirectives = hashDirectives)) = x in hashDirectives) + member x.HashDirectives = + (let (ParsedImplFileInput (hashDirectives = hashDirectives)) = x in hashDirectives) member x.FileName = (let (ParsedImplFileInput (fileName = fileName)) = x in fileName) @@ -1692,7 +1695,8 @@ type ParsedImplFileInput = member x.IsScript = (let (ParsedImplFileInput (isScript = isScript)) = x in isScript) - member x.IsLastCompiland = (let (ParsedImplFileInput (flags = (isLastCompiland, _))) = x in isLastCompiland) + member x.IsLastCompiland = + (let (ParsedImplFileInput (flags = (isLastCompiland, _))) = x in isLastCompiland) member x.IsExe = (let (ParsedImplFileInput (flags = (_, isExe))) = x in isExe) @@ -1708,11 +1712,14 @@ type ParsedSigFileInput = contents: SynModuleOrNamespaceSig list * trivia: ParsedSigFileInputTrivia - member x.QualifiedName = (let (ParsedSigFileInput (qualifiedNameOfFile = qualNameOfFile)) = x in qualNameOfFile) + member x.QualifiedName = + (let (ParsedSigFileInput (qualifiedNameOfFile = qualNameOfFile)) = x in qualNameOfFile) - member x.ScopedPragmas = (let (ParsedSigFileInput (scopedPragmas = scopedPragmas)) = x in scopedPragmas) + member x.ScopedPragmas = + (let (ParsedSigFileInput (scopedPragmas = scopedPragmas)) = x in scopedPragmas) - member x.HashDirectives = (let (ParsedSigFileInput (hashDirectives = hashDirectives)) = x in hashDirectives) + member x.HashDirectives = + (let (ParsedSigFileInput (hashDirectives = hashDirectives)) = x in hashDirectives) member x.FileName = (let (ParsedSigFileInput (fileName = fileName)) = x in fileName) diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fsi b/src/Compiler/SyntaxTree/SyntaxTree.fsi index d777f8cd2f9..b1538eaa489 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTree.fsi @@ -1947,4 +1947,3 @@ type ParsedInput = /// Gets the #nowarn and other scoped pragmas member ScopedPragmas: ScopedPragma list - From 5973c8e72912d4552631dce9c68c094172cf1c15 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 23 Aug 2022 15:16:03 +0100 Subject: [PATCH 05/33] update surface area --- ...erService.SurfaceArea.netstandard.expected | 46 ++++++++++++++++--- 1 file changed, 40 insertions(+), 6 deletions(-) diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected index 083c2ea9310..51d287c47c0 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected @@ -5528,26 +5528,44 @@ FSharp.Compiler.Syntax.ParsedImplFileFragment: Int32 Tag FSharp.Compiler.Syntax.ParsedImplFileFragment: Int32 get_Tag() FSharp.Compiler.Syntax.ParsedImplFileFragment: System.String ToString() FSharp.Compiler.Syntax.ParsedImplFileInput +FSharp.Compiler.Syntax.ParsedImplFileInput: Boolean IsExe +FSharp.Compiler.Syntax.ParsedImplFileInput: Boolean IsLastCompiland +FSharp.Compiler.Syntax.ParsedImplFileInput: Boolean IsScript +FSharp.Compiler.Syntax.ParsedImplFileInput: Boolean get_IsExe() +FSharp.Compiler.Syntax.ParsedImplFileInput: Boolean get_IsLastCompiland() +FSharp.Compiler.Syntax.ParsedImplFileInput: Boolean get_IsScript() FSharp.Compiler.Syntax.ParsedImplFileInput: Boolean get_isScript() FSharp.Compiler.Syntax.ParsedImplFileInput: Boolean isScript FSharp.Compiler.Syntax.ParsedImplFileInput: FSharp.Compiler.Syntax.ParsedImplFileInput NewParsedImplFileInput(System.String, Boolean, FSharp.Compiler.Syntax.QualifiedNameOfFile, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedHashDirective], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespace], System.Tuple`2[System.Boolean,System.Boolean], FSharp.Compiler.SyntaxTrivia.ParsedImplFileInputTrivia) +FSharp.Compiler.Syntax.ParsedImplFileInput: FSharp.Compiler.Syntax.QualifiedNameOfFile QualifiedName +FSharp.Compiler.Syntax.ParsedImplFileInput: FSharp.Compiler.Syntax.QualifiedNameOfFile get_QualifiedName() FSharp.Compiler.Syntax.ParsedImplFileInput: FSharp.Compiler.Syntax.QualifiedNameOfFile get_qualifiedNameOfFile() FSharp.Compiler.Syntax.ParsedImplFileInput: FSharp.Compiler.Syntax.QualifiedNameOfFile qualifiedNameOfFile +FSharp.Compiler.Syntax.ParsedImplFileInput: FSharp.Compiler.SyntaxTrivia.ParsedImplFileInputTrivia Trivia +FSharp.Compiler.Syntax.ParsedImplFileInput: FSharp.Compiler.SyntaxTrivia.ParsedImplFileInputTrivia get_Trivia() FSharp.Compiler.Syntax.ParsedImplFileInput: FSharp.Compiler.SyntaxTrivia.ParsedImplFileInputTrivia get_trivia() FSharp.Compiler.Syntax.ParsedImplFileInput: FSharp.Compiler.SyntaxTrivia.ParsedImplFileInputTrivia trivia FSharp.Compiler.Syntax.ParsedImplFileInput: Int32 Tag FSharp.Compiler.Syntax.ParsedImplFileInput: Int32 get_Tag() +FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedHashDirective] HashDirectives +FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedHashDirective] get_HashDirectives() FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedHashDirective] get_hashDirectives() FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedHashDirective] hashDirectives +FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma] ScopedPragmas +FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma] get_ScopedPragmas() FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma] get_scopedPragmas() FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma] scopedPragmas -FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespace] get_modules() -FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespace] modules +FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespace] Contents +FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespace] contents +FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespace] get_Contents() +FSharp.Compiler.Syntax.ParsedImplFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespace] get_contents() +FSharp.Compiler.Syntax.ParsedImplFileInput: System.String FileName FSharp.Compiler.Syntax.ParsedImplFileInput: System.String ToString() FSharp.Compiler.Syntax.ParsedImplFileInput: System.String fileName +FSharp.Compiler.Syntax.ParsedImplFileInput: System.String get_FileName() FSharp.Compiler.Syntax.ParsedImplFileInput: System.String get_fileName() -FSharp.Compiler.Syntax.ParsedImplFileInput: System.Tuple`2[System.Boolean,System.Boolean] get_isLastCompiland() -FSharp.Compiler.Syntax.ParsedImplFileInput: System.Tuple`2[System.Boolean,System.Boolean] isLastCompiland +FSharp.Compiler.Syntax.ParsedImplFileInput: System.Tuple`2[System.Boolean,System.Boolean] flags +FSharp.Compiler.Syntax.ParsedImplFileInput: System.Tuple`2[System.Boolean,System.Boolean] get_flags() FSharp.Compiler.Syntax.ParsedInput FSharp.Compiler.Syntax.ParsedInput+ImplFile: FSharp.Compiler.Syntax.ParsedImplFileInput Item FSharp.Compiler.Syntax.ParsedInput+ImplFile: FSharp.Compiler.Syntax.ParsedImplFileInput get_Item() @@ -5564,10 +5582,14 @@ FSharp.Compiler.Syntax.ParsedInput: FSharp.Compiler.Syntax.ParsedInput NewSigFil FSharp.Compiler.Syntax.ParsedInput: FSharp.Compiler.Syntax.ParsedInput+ImplFile FSharp.Compiler.Syntax.ParsedInput: FSharp.Compiler.Syntax.ParsedInput+SigFile FSharp.Compiler.Syntax.ParsedInput: FSharp.Compiler.Syntax.ParsedInput+Tags +FSharp.Compiler.Syntax.ParsedInput: FSharp.Compiler.Syntax.QualifiedNameOfFile QualifiedName +FSharp.Compiler.Syntax.ParsedInput: FSharp.Compiler.Syntax.QualifiedNameOfFile get_QualifiedName() 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: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma] ScopedPragmas +FSharp.Compiler.Syntax.ParsedInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma] get_ScopedPragmas() FSharp.Compiler.Syntax.ParsedInput: System.String FileName FSharp.Compiler.Syntax.ParsedInput: System.String ToString() FSharp.Compiler.Syntax.ParsedInput: System.String get_FileName() @@ -5647,20 +5669,32 @@ FSharp.Compiler.Syntax.ParsedSigFileFragment: Int32 get_Tag() FSharp.Compiler.Syntax.ParsedSigFileFragment: System.String ToString() FSharp.Compiler.Syntax.ParsedSigFileInput FSharp.Compiler.Syntax.ParsedSigFileInput: FSharp.Compiler.Syntax.ParsedSigFileInput NewParsedSigFileInput(System.String, FSharp.Compiler.Syntax.QualifiedNameOfFile, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedHashDirective], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespaceSig], FSharp.Compiler.SyntaxTrivia.ParsedSigFileInputTrivia) +FSharp.Compiler.Syntax.ParsedSigFileInput: FSharp.Compiler.Syntax.QualifiedNameOfFile QualifiedName +FSharp.Compiler.Syntax.ParsedSigFileInput: FSharp.Compiler.Syntax.QualifiedNameOfFile get_QualifiedName() FSharp.Compiler.Syntax.ParsedSigFileInput: FSharp.Compiler.Syntax.QualifiedNameOfFile get_qualifiedNameOfFile() FSharp.Compiler.Syntax.ParsedSigFileInput: FSharp.Compiler.Syntax.QualifiedNameOfFile qualifiedNameOfFile +FSharp.Compiler.Syntax.ParsedSigFileInput: FSharp.Compiler.SyntaxTrivia.ParsedSigFileInputTrivia Trivia +FSharp.Compiler.Syntax.ParsedSigFileInput: FSharp.Compiler.SyntaxTrivia.ParsedSigFileInputTrivia get_Trivia() FSharp.Compiler.Syntax.ParsedSigFileInput: FSharp.Compiler.SyntaxTrivia.ParsedSigFileInputTrivia get_trivia() FSharp.Compiler.Syntax.ParsedSigFileInput: FSharp.Compiler.SyntaxTrivia.ParsedSigFileInputTrivia trivia FSharp.Compiler.Syntax.ParsedSigFileInput: Int32 Tag FSharp.Compiler.Syntax.ParsedSigFileInput: Int32 get_Tag() +FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedHashDirective] HashDirectives +FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedHashDirective] get_HashDirectives() FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedHashDirective] get_hashDirectives() FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ParsedHashDirective] hashDirectives +FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma] ScopedPragmas +FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma] get_ScopedPragmas() FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma] get_scopedPragmas() FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.ScopedPragma] scopedPragmas -FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespaceSig] get_modules() -FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespaceSig] modules +FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespaceSig] Contents +FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespaceSig] contents +FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespaceSig] get_Contents() +FSharp.Compiler.Syntax.ParsedSigFileInput: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynModuleOrNamespaceSig] get_contents() +FSharp.Compiler.Syntax.ParsedSigFileInput: System.String FileName FSharp.Compiler.Syntax.ParsedSigFileInput: System.String ToString() FSharp.Compiler.Syntax.ParsedSigFileInput: System.String fileName +FSharp.Compiler.Syntax.ParsedSigFileInput: System.String get_FileName() FSharp.Compiler.Syntax.ParsedSigFileInput: System.String get_fileName() FSharp.Compiler.Syntax.ParserDetail FSharp.Compiler.Syntax.ParserDetail+Tags: Int32 ErrorRecovery From f73c7f3d7e4ff686aff4dcff43803aadf937fbbe Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 24 Aug 2022 00:52:10 +0100 Subject: [PATCH 06/33] simplify diagnostic logging and format diagnostics eagerly when processing in parallel --- src/Compiler/Driver/CompilerDiagnostics.fs | 124 +++++++----------- src/Compiler/Driver/CompilerDiagnostics.fsi | 9 +- src/Compiler/Driver/ParseAndCheckInputs.fs | 85 +++--------- src/Compiler/Driver/ParseAndCheckInputs.fsi | 19 ++- src/Compiler/Driver/fsc.fs | 68 ++++------ src/Compiler/Driver/fsc.fsi | 13 +- src/Compiler/Facilities/DiagnosticsLogger.fs | 7 +- src/Compiler/Facilities/DiagnosticsLogger.fsi | 5 +- src/Compiler/Interactive/fsi.fs | 6 +- .../Legacy/LegacyHostedCompilerForTesting.fs | 12 +- src/Compiler/Service/service.fs | 12 +- src/Compiler/Symbols/FSharpDiagnostic.fs | 24 ++-- .../RecursiveSafetyAnalysis.fs | 2 +- tests/FSharp.Test.Utilities/Compiler.fs | 12 +- 14 files changed, 160 insertions(+), 238 deletions(-) diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index a6e0450af3a..7441d4b80eb 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -384,41 +384,37 @@ let IsWarningOrInfoEnabled (diagnostic, severity) n level specificWarnOn = || (severity = FSharpDiagnosticSeverity.Warning && level >= GetWarningLevel diagnostic) -let SplitRelatedDiagnostics (diagnostic: PhasedDiagnostic) : PhasedDiagnostic * PhasedDiagnostic list = - let ToPhased exn = - { - Exception = exn - Phase = diagnostic.Phase - } - - let rec SplitRelatedException exn = - match exn with - | ErrorFromAddingTypeEquation (g, denv, ty1, ty2, exn2, m) -> - let diag2, related = SplitRelatedException exn2 - ErrorFromAddingTypeEquation(g, denv, ty1, ty2, diag2.Exception, m) |> ToPhased, related - | ErrorFromApplyingDefault (g, denv, tp, defaultType, exn2, m) -> - let diag2, related = SplitRelatedException exn2 - - ErrorFromApplyingDefault(g, denv, tp, defaultType, diag2.Exception, m) - |> ToPhased, - related - | ErrorsFromAddingSubsumptionConstraint (g, denv, ty1, ty2, exn2, contextInfo, m) -> - let diag2, related = SplitRelatedException exn2 - - ErrorsFromAddingSubsumptionConstraint(g, denv, ty1, ty2, diag2.Exception, contextInfo, m) - |> ToPhased, - related - | ErrorFromAddingConstraint (x, exn2, m) -> - let diag2, related = SplitRelatedException exn2 - ErrorFromAddingConstraint(x, diag2.Exception, m) |> ToPhased, related - | WrappedError (exn2, m) -> - let diag2, related = SplitRelatedException exn2 - WrappedError(diag2.Exception, m) |> ToPhased, related - // Strip TargetInvocationException wrappers - | :? TargetInvocationException as exn -> SplitRelatedException exn.InnerException - | _ -> ToPhased exn, [] +let ToPhased phase exn = + { + Exception = exn + Phase = phase + } - SplitRelatedException diagnostic.Exception +let rec StripRelatedException phase exn = + match exn with + | ErrorFromAddingTypeEquation (g, denv, ty1, ty2, exn2, m) -> + let diag2 = StripRelatedException phase exn2 + ErrorFromAddingTypeEquation(g, denv, ty1, ty2, diag2.Exception, m) |> ToPhased phase + | ErrorFromApplyingDefault (g, denv, tp, defaultType, exn2, m) -> + let diag2 = StripRelatedException phase exn2 + ErrorFromApplyingDefault(g, denv, tp, defaultType, diag2.Exception, m) + |> ToPhased phase + | ErrorsFromAddingSubsumptionConstraint (g, denv, ty1, ty2, exn2, contextInfo, m) -> + let diag2 = StripRelatedException phase exn2 + ErrorsFromAddingSubsumptionConstraint(g, denv, ty1, ty2, diag2.Exception, contextInfo, m) + |> ToPhased phase + | ErrorFromAddingConstraint (x, exn2, m) -> + let diag2 = StripRelatedException phase exn2 + ErrorFromAddingConstraint(x, diag2.Exception, m) |> ToPhased phase + | WrappedError (exn2, m) -> + let diag2 = StripRelatedException phase exn2 + WrappedError(diag2.Exception, m) |> ToPhased phase + // Strip TargetInvocationException wrappers + | :? TargetInvocationException as exn -> StripRelatedException phase exn.InnerException + | _ -> ToPhased phase exn + +let StripRelatedDiagnostics (diagnostic: PhasedDiagnostic) = + StripRelatedException diagnostic.Phase diagnostic.Exception let Message (name, format) = DeclareResourceString(name, format) @@ -1890,6 +1886,17 @@ let OutputPhasedDiagnostic (os: StringBuilder) (diagnostic: PhasedDiagnostic) (f os.AppendString text +/// Eagerly format a PhasedDiagnostic to a DiagnosticWithText +let EagerlyFormatDiagnostic (flattenErrors: bool) (suggestNames: bool) (diagnostic: PhasedDiagnostic) = + match GetRangeOfDiagnostic diagnostic with + | Some m -> + let os = StringBuilder() + OutputPhasedDiagnostic os diagnostic flattenErrors suggestNames + let message = os.ToString() + DiagnosticWithText(GetDiagnosticNumber diagnostic, message, m) + |> ToPhased diagnostic.Phase + | None -> diagnostic + let SanitizeFileName fileName implicitIncludeDir = // The assert below is almost ok, but it fires in two cases: // - fsi.exe sometimes passes "stdin" as a dummy file name @@ -2032,11 +2039,6 @@ let CollectFormattedDiagnostics let errors = ResizeArray() let report diagnostic = - let OutputWhere diagnostic = - match GetRangeOfDiagnostic diagnostic with - | Some m -> Some(outputWhere (showFullPaths, diagnosticStyle) m) - | None -> None - let OutputCanonicalInformation (subcategory, errorNumber) : FormattedDiagnosticCanonicalInformation = let message = match severity with @@ -2057,15 +2059,19 @@ let CollectFormattedDiagnostics TextRepresentation = text } - let mainError, relatedErrors = SplitRelatedDiagnostics diagnostic - let where = OutputWhere mainError + let diag = StripRelatedDiagnostics diagnostic + + let where = + match GetRangeOfDiagnostic diag with + | Some m -> Some(outputWhere (showFullPaths, diagnosticStyle) m) + | None -> None let canonical = - OutputCanonicalInformation(diagnostic.Subcategory(), GetDiagnosticNumber mainError) + OutputCanonicalInformation(diagnostic.Subcategory(), GetDiagnosticNumber diag) let message = let os = StringBuilder() - OutputPhasedDiagnostic os mainError flattenErrors suggestNames + OutputPhasedDiagnostic os diag flattenErrors suggestNames os.ToString() let entry: FormattedDiagnosticDetailedInfo = @@ -2077,36 +2083,6 @@ let CollectFormattedDiagnostics errors.Add(FormattedDiagnostic.Long(severity, entry)) - let OutputRelatedError (diagnostic: PhasedDiagnostic) = - match diagnosticStyle with - // Give a canonical string when --vserror. - | DiagnosticStyle.VisualStudio -> - let relWhere = OutputWhere mainError // mainError? - - let relCanonical = - OutputCanonicalInformation(diagnostic.Subcategory(), GetDiagnosticNumber mainError) // Use main error for code - - let relMessage = - let os = StringBuilder() - OutputPhasedDiagnostic os diagnostic flattenErrors suggestNames - os.ToString() - - let entry: FormattedDiagnosticDetailedInfo = - { - Location = relWhere - Canonical = relCanonical - Message = relMessage - } - - errors.Add(FormattedDiagnostic.Long(severity, entry)) - - | _ -> - let os = StringBuilder() - OutputPhasedDiagnostic os diagnostic flattenErrors suggestNames - errors.Add(FormattedDiagnostic.Short(severity, os.ToString())) - - relatedErrors |> List.iter OutputRelatedError - match diagnostic with #if !NO_TYPEPROVIDERS | { @@ -2122,7 +2098,7 @@ let CollectFormattedDiagnostics /// 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, diagnosticStyle, severity) os (diagnostic: PhasedDiagnostic) = +let OutputDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, diagnosticStyle, severity) os (diagnostic: 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 = diff --git a/src/Compiler/Driver/CompilerDiagnostics.fsi b/src/Compiler/Driver/CompilerDiagnostics.fsi index 565269961aa..84eed299daa 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fsi +++ b/src/Compiler/Driver/CompilerDiagnostics.fsi @@ -53,8 +53,13 @@ val GetRangeOfDiagnostic: diagnostic: PhasedDiagnostic -> range option /// Get the number associated with an error val GetDiagnosticNumber: diagnostic: PhasedDiagnostic -> int -/// Split errors into a "main" error and a set of associated errors -val SplitRelatedDiagnostics: diagnostic: PhasedDiagnostic -> PhasedDiagnostic * PhasedDiagnostic list +/// Rewrite a diagnostic stripping TargetInvocationException from any exceptions inside it +/// +/// TODO: this routine probably isn't necessary +val StripRelatedDiagnostics: diagnostic: PhasedDiagnostic -> PhasedDiagnostic + +/// Eagerly format a PhasedDiagnostic to a DiagnosticWithText +val EagerlyFormatDiagnostic: flattenErrors: bool -> suggestNames: bool -> diagnostic: PhasedDiagnostic -> PhasedDiagnostic /// Output an error to a buffer val OutputPhasedDiagnostic: diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 1e27e97bc24..db45b3593ab 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -727,38 +727,6 @@ let ParseOneInputFile (tcConfig: TcConfig, lexResourceManager, fileName, isLastC errorRecovery exn rangeStartup EmptyParsedInput(fileName, isLastCompiland) -(* -let ProcessInParallel - ( - workSpecs, - diagnosticsLogger: DiagnosticsLogger, - exiter: Exiter, - createDiagnosticsLogger: Exiter -> CapturingDiagnosticsLogger - ) = - - let workSpecs = - workSpecs - |> Array.ofList - - let results = - try - try - workSpecs - |> ArrayParallel.mapi (fun i work -> - work () - ) - finally - for logger in capturingDiagnosticLoggers do - logger.CommitDelayedDiagnostics diagnosticsLogger - with StopProcessing -> - if exitCode > 0 then - exiter.Exit exitCode - else - reraise() - - results |> List.ofArray -*) - /// Prepare to process inputs independently, e.g. partially in parallel. /// /// To do this we create one CapturingDiagnosticLogger for each input and @@ -771,35 +739,24 @@ let ProcessInParallel /// NOTE: this needs to be improved to commit diagnotics as soon as possible /// /// NOTE: If StopProcessing is raised by any piece of work then the overall function raises StopProcessing. -let UseMultipleDiagnosticLoggers - (inputs, exiter: Exiter, diagnosticsLogger, createDiagnosticsLogger: Exiter -> CapturingDiagnosticsLogger) - f - = - let delayedExiter = StopProcessingExiter() +let UseMultipleDiagnosticLoggers (inputs, diagnosticsLogger, eagerFormat) f = // Check input files and create delayed error loggers before we try to parallel parse. - let capturingDiagnosticLoggers = - inputs |> List.map (fun _ -> createDiagnosticsLogger delayedExiter) + let delayLoggers = + inputs |> List.map (fun _ -> CapturingDiagnosticsLogger("TcDiagnosticsLogger", ?eagerFormat=eagerFormat)) try - try - f (List.zip inputs capturingDiagnosticLoggers) - finally - for logger in capturingDiagnosticLoggers do - logger.CommitDelayedDiagnostics diagnosticsLogger - with StopProcessing -> - if delayedExiter.ExitCode > 0 then - exiter.Exit delayedExiter.ExitCode - else - reraise () + f (List.zip inputs delayLoggers) + finally + for logger in delayLoggers do + logger.CommitDelayedDiagnostics diagnosticsLogger let ParseInputFilesInParallel ( tcConfig: TcConfig, lexResourceManager, sourceFiles, - diagnosticsLogger: DiagnosticsLogger, - createDiagnosticsLogger: Exiter -> CapturingDiagnosticsLogger, + delayLogger: DiagnosticsLogger, retryLocked ) = @@ -810,13 +767,13 @@ let ParseInputFilesInParallel let sourceFiles = List.zip sourceFiles isLastCompiland - UseMultipleDiagnosticLoggers (sourceFiles, exiter, diagnosticsLogger, createDiagnosticsLogger) (fun sourceFilesWithCapturingLoggers -> - sourceFilesWithCapturingLoggers - |> ListParallel.map (fun ((fileName, isLastCompiland), capturingDiagnosticLogger) -> + UseMultipleDiagnosticLoggers (sourceFiles, delayLogger, None) (fun sourceFilesWithDelayLoggers -> + sourceFilesWithDelayLoggers + |> ListParallel.map (fun ((fileName, isLastCompiland), delayLogger) -> let directoryName = Path.GetDirectoryName fileName let input = - parseInputFileAux (tcConfig, lexResourceManager, fileName, (isLastCompiland, isExe), capturingDiagnosticLogger, retryLocked) + parseInputFileAux (tcConfig, lexResourceManager, fileName, (isLastCompiland, isExe), delayLogger, retryLocked) (input, directoryName))) @@ -842,7 +799,6 @@ let ParseInputFiles sourceFiles, diagnosticsLogger: DiagnosticsLogger, exiter: Exiter, - createDiagnosticsLogger: Exiter -> CapturingDiagnosticsLogger, retryLocked ) = try @@ -852,8 +808,6 @@ let ParseInputFiles lexResourceManager, sourceFiles, diagnosticsLogger, - exiter, - createDiagnosticsLogger, retryLocked ) else @@ -1500,8 +1454,7 @@ let CheckMultipleInputsInParallel tcGlobals, prefixPathOpt, tcState, - exiter, - createDiagnosticsLogger, + eagerFormat, inputs ) = @@ -1509,7 +1462,11 @@ let CheckMultipleInputsInParallel // We create one CapturingDiagnosticLogger for each file we are processing and // ensure the diagnostics are presented in deterministic order. - UseMultipleDiagnosticLoggers (inputs, exiter, diagnosticsLogger, createDiagnosticsLogger) (fun inputsWithLoggers -> + // + // eagerFormat is used to format diagnostics as they are emitted, just as they would be in the command-line + // compiler. This is necessary because some formatting of diagnostics is dependent on the + // type inference state at precisely the time the diagnostic is emitted. + UseMultipleDiagnosticLoggers (inputs, diagnosticsLogger, Some eagerFormat) (fun inputsWithLoggers -> // Equip loggers to locally filter w.r.t. scope pragmas in each input let inputsWithLoggers = @@ -1617,8 +1574,7 @@ let CheckClosedInputSet tcGlobals, prefixPathOpt, tcState, - exiter, - createDiagnosticsLogger, + eagerFormat, inputs ) = @@ -1638,8 +1594,7 @@ let CheckClosedInputSet tcGlobals, prefixPathOpt, tcState, - exiter, - createDiagnosticsLogger, + eagerFormat, inputs ) else diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index 355c8a67037..69e13d79430 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -102,7 +102,7 @@ val ParseInputFiles: lexResourceManager: Lexhelp.LexResourceManager * sourceFiles: string list * diagnosticsLogger: DiagnosticsLogger * - createDiagnosticsLogger: (Exiter -> CapturingDiagnosticsLogger) * + exiter: Exiter * retryLocked: bool -> (ParsedInput * string) list @@ -163,19 +163,18 @@ val CheckClosedInputSet: tcGlobals: TcGlobals * prefixPathOpt: LongIdent option * tcState: TcState * - exiter: Exiter * - createDiagnosticsLogger: (Exiter -> CapturingDiagnosticsLogger) * + eagerFormat: (PhasedDiagnostic -> PhasedDiagnostic) * inputs: ParsedInput list -> TcState * TopAttribs * CheckedImplFile list * TcEnv /// Check a single input and finish the checking val CheckOneInputAndFinish: checkForErrors: (unit -> bool) * - TcConfig * - TcImports * - TcGlobals * - LongIdent option * - NameResolution.TcResultsSink * - TcState * - ParsedInput -> + tcConfig: TcConfig * + tcImports: TcImports * + tcGlobals: TcGlobals * + prefixPathOpt: LongIdent option * + tcSink: NameResolution.TcResultsSink * + tcState: TcState * + input: ParsedInput -> Cancellable<(TcEnv * TopAttribs * CheckedImplFile list * ModuleOrNamespaceType list) * TcState> diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index a1be81257c5..9cca72565a4 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -99,8 +99,8 @@ type DiagnosticsLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, x.HandleIssue(tcConfigB, diagnostic, severity) /// Create an error logger that counts and prints errors -let ConsoleDiagnosticsLoggerUpToMaxErrors (tcConfigB: TcConfigBuilder, exiter: Exiter) = - { new DiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter, "ConsoleDiagnosticsLoggerUpToMaxErrors") with +let ConsoleDiagnosticsLogger (tcConfigB: TcConfigBuilder, exiter: Exiter) = + { new DiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter, "ConsoleDiagnosticsLogger") with member _.HandleTooManyErrors(text: string) = DoWithDiagnosticColor FSharpDiagnosticSeverity.Warning (fun () -> Printf.eprintfn "%s" text) @@ -121,31 +121,29 @@ let ConsoleDiagnosticsLoggerUpToMaxErrors (tcConfigB: TcConfigBuilder, exiter: E } :> DiagnosticsLogger -/// This error logger delays the messages it receives. At the end, call ForwardDelayedDiagnostics -/// to send the held messages. -type DelayAndForwardDiagnosticsLogger(exiter: Exiter, diagnosticsLoggerProvider: DiagnosticsLoggerProvider) = - inherit CapturingDiagnosticsLogger("DelayAndForwardDiagnosticsLogger") - member x.ForwardDelayedDiagnostics(tcConfigB: TcConfigBuilder) = - let diagnosticsLogger = - diagnosticsLoggerProvider.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter) - - x.CommitDelayedDiagnostics diagnosticsLogger +/// DiagnosticLoggers can be sensitive to the TcConfig flags. During the checking +/// of the flags themselves we have to create temporary loggers, until the full configuration is +/// available. +type DiagnosticsLoggerProvider = -and [] DiagnosticsLoggerProvider() = + abstract CreateLogger: tcConfigB: TcConfigBuilder * exiter: Exiter -> DiagnosticsLogger - member this.CreateDelayAndForwardLogger exiter = - DelayAndForwardDiagnosticsLogger(exiter, this) +type CapturingDiagnosticsLogger with - abstract CreateDiagnosticsLoggerUpToMaxErrors: tcConfigBuilder: TcConfigBuilder * exiter: Exiter -> DiagnosticsLogger + /// Commit the delayed diagnostics via a fresh temporary logger of the right kind. + member x.CommitDelayedDiagnostics(diagnosticsLoggerProvider: DiagnosticsLoggerProvider, tcConfigB, exiter) = + let diagnosticsLogger = + diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter) + x.CommitDelayedDiagnostics diagnosticsLogger /// The default DiagnosticsLogger implementation, reporting messages to the Console up to the maxerrors maximum type ConsoleLoggerProvider() = - inherit DiagnosticsLoggerProvider() + interface DiagnosticsLoggerProvider with - override _.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) = - ConsoleDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) + member _.CreateLogger(tcConfigB, exiter) = + ConsoleDiagnosticsLogger(tcConfigB, exiter) /// Notify the exiter if any error has occurred let AbortOnError (diagnosticsLogger: DiagnosticsLogger, exiter: Exiter) = @@ -158,7 +156,6 @@ let TypeCheck tcConfig, tcImports, tcGlobals, - diagnosticsLoggerProvider: DiagnosticsLoggerProvider, diagnosticsLogger: DiagnosticsLogger, assemblyName, tcEnv0, @@ -175,8 +172,8 @@ let TypeCheck let tcInitialState = GetInitialTcState(rangeStartup, ccuName, tcConfig, tcGlobals, tcImports, tcEnv0, openDecls0) - let createDiagnosticsLogger = - (fun exiter -> diagnosticsLoggerProvider.CreateDelayAndForwardLogger(exiter) :> CapturingDiagnosticsLogger) + let eagerFormat diag = + EagerlyFormatDiagnostic tcConfig.flatErrors true diag CheckClosedInputSet( ctok, @@ -186,8 +183,7 @@ let TypeCheck tcGlobals, None, tcInitialState, - exiter, - createDiagnosticsLogger, + eagerFormat, inputs ) with exn -> @@ -524,7 +520,7 @@ let main1 // Now install a delayed logger to hold all errors from flags until after all flags have been parsed (for example, --vserrors) let delayForFlagsLogger = - diagnosticsLoggerProvider.CreateDelayAndForwardLogger exiter + CapturingDiagnosticsLogger("DelayFlagsLogger") let _holder = UseDiagnosticsLogger delayForFlagsLogger @@ -543,7 +539,7 @@ let main1 AdjustForScriptCompile(tcConfigB, files, lexResourceManager, dependencyProvider) with e -> errorRecovery e rangeStartup - delayForFlagsLogger.ForwardDelayedDiagnostics tcConfigB + delayForFlagsLogger.CommitDelayedDiagnostics (diagnosticsLoggerProvider, tcConfigB, exiter) exiter.Exit 1 tcConfigB.conditionalDefines <- "COMPILED" :: tcConfigB.conditionalDefines @@ -558,12 +554,12 @@ let main1 tcConfigB.DecideNames sourceFiles with e -> errorRecovery e rangeStartup - delayForFlagsLogger.ForwardDelayedDiagnostics tcConfigB + delayForFlagsLogger.CommitDelayedDiagnostics (diagnosticsLoggerProvider, tcConfigB, exiter) exiter.Exit 1 // DecideNames may give "no inputs" error. Abort on error at this point. bug://3911 if not tcConfigB.continueAfterParseFailure && delayForFlagsLogger.ErrorCount > 0 then - delayForFlagsLogger.ForwardDelayedDiagnostics tcConfigB + delayForFlagsLogger.CommitDelayedDiagnostics (diagnosticsLoggerProvider, tcConfigB, exiter) exiter.Exit 1 // If there's a problem building TcConfig, abort @@ -572,11 +568,11 @@ let main1 TcConfig.Create(tcConfigB, validate = false) with e -> errorRecovery e rangeStartup - delayForFlagsLogger.ForwardDelayedDiagnostics tcConfigB + delayForFlagsLogger.CommitDelayedDiagnostics (diagnosticsLoggerProvider, tcConfigB, exiter) exiter.Exit 1 let diagnosticsLogger = - diagnosticsLoggerProvider.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter) + diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter) // Install the global error logger and never remove it. This logger does have all command-line flags considered. let _holder = UseDiagnosticsLogger diagnosticsLogger @@ -611,11 +607,8 @@ let main1 ReportTime tcConfig "Parse inputs" use unwindParsePhase = UseBuildPhase BuildPhase.Parse - let createDiagnosticsLogger = - (fun exiter -> diagnosticsLoggerProvider.CreateDelayAndForwardLogger(exiter) :> CapturingDiagnosticsLogger) - let inputs = - ParseInputFiles(tcConfig, lexResourceManager, sourceFiles, diagnosticsLogger, createDiagnosticsLogger, false) + ParseInputFiles(tcConfig, lexResourceManager, sourceFiles, diagnosticsLogger, exiter, false) let inputs, _ = (Map.empty, inputs) @@ -677,7 +670,6 @@ let main1 tcConfig, tcImports, tcGlobals, - diagnosticsLoggerProvider, diagnosticsLogger, assemblyName, tcEnv0, @@ -783,8 +775,7 @@ let main1OfAst SetTailcallSwitch tcConfigB OptionSwitch.On // Now install a delayed logger to hold all errors from flags until after all flags have been parsed (for example, --vserrors) - let delayForFlagsLogger = - diagnosticsLoggerProvider.CreateDelayAndForwardLogger exiter + let delayForFlagsLogger = CapturingDiagnosticsLogger("DelayForFlagsLogger") let _holder = UseDiagnosticsLogger delayForFlagsLogger @@ -799,13 +790,13 @@ let main1OfAst try TcConfig.Create(tcConfigB, validate = false) with e -> - delayForFlagsLogger.ForwardDelayedDiagnostics tcConfigB + delayForFlagsLogger.CommitDelayedDiagnostics (diagnosticsLoggerProvider, tcConfigB, exiter) exiter.Exit 1 let dependencyProvider = new DependencyProvider() let diagnosticsLogger = - diagnosticsLoggerProvider.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter) + diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter) // Install the global error logger and never remove it. This logger does have all command-line flags considered. let _holder = UseDiagnosticsLogger diagnosticsLogger @@ -862,7 +853,6 @@ let main1OfAst tcConfig, tcImports, tcGlobals, - diagnosticsLoggerProvider, diagnosticsLogger, assemblyName, tcEnv0, diff --git a/src/Compiler/Driver/fsc.fsi b/src/Compiler/Driver/fsc.fsi index 12ed13273da..57ec172fa57 100644 --- a/src/Compiler/Driver/fsc.fsi +++ b/src/Compiler/Driver/fsc.fsi @@ -13,18 +13,19 @@ open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Syntax open FSharp.Compiler.TcGlobals -[] +/// DiagnosticLoggers can be sensitive to the TcConfig flags. During the checking +/// of the flags themselves we have to create temporary loggers, until the full configuration is +/// available. type DiagnosticsLoggerProvider = - new: unit -> DiagnosticsLoggerProvider - abstract CreateDiagnosticsLoggerUpToMaxErrors: - tcConfigBuilder: TcConfigBuilder * exiter: Exiter -> DiagnosticsLogger + abstract CreateLogger: + tcConfigB: TcConfigBuilder * exiter: Exiter -> DiagnosticsLogger /// The default DiagnosticsLoggerProvider implementation, reporting messages to the Console up to the maxerrors maximum type ConsoleLoggerProvider = new: unit -> ConsoleLoggerProvider - inherit DiagnosticsLoggerProvider + interface DiagnosticsLoggerProvider -/// An error logger that reports errors up to some maximum, notifying the exiter when that maximum is reached +/// An diagnostic logger that reports errors up to some maximum, notifying the exiter when that maximum is reached /// /// Used only in LegacyHostedCompilerForTesting [] diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index f384a477a7c..8bf00bef80f 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -331,12 +331,17 @@ let AssertFalseDiagnosticsLogger = member _.ErrorCount = (* assert false; *) 0 } -type CapturingDiagnosticsLogger(nm) = +type CapturingDiagnosticsLogger(nm, ?eagerFormat) = inherit DiagnosticsLogger(nm) let mutable errorCount = 0 let diagnostics = ResizeArray() override _.DiagnosticSink(diagnostic, severity) = + let diagnostic = + match eagerFormat with + | None -> diagnostic + | Some f -> f diagnostic + if severity = FSharpDiagnosticSeverity.Error then errorCount <- errorCount + 1 diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index 0736d00f917..0ac4c90583e 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -199,11 +199,12 @@ val DiscardErrorsLogger: DiagnosticsLogger /// Represents a DiagnosticsLogger that ignores diagnostics and asserts val AssertFalseDiagnosticsLogger: DiagnosticsLogger -/// Represents a DiagnosticsLogger that captures all diagnostics +/// Represents a DiagnosticsLogger that captures all diagnostics, optionally formatting them +/// eagerly. type CapturingDiagnosticsLogger = inherit DiagnosticsLogger - new: nm: string -> CapturingDiagnosticsLogger + new: nm: string * ?eagerFormat: (PhasedDiagnostic -> PhasedDiagnostic) -> CapturingDiagnosticsLogger member CommitDelayedDiagnostics: diagnosticsLogger: DiagnosticsLogger -> unit diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index b226484ef24..084bad942b3 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -1672,6 +1672,9 @@ type internal FsiDynamicCompiler( let ilxGenerator = istate.ilxGenerator let tcConfig = TcConfig.Create(tcConfigB,validate=false) + let eagerFormat diag = + EagerlyFormatDiagnostic tcConfig.flatErrors true diag + // 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, topCustomAttrs, declaredImpls, tcEnvAtEndOfLastInput = @@ -1684,8 +1687,7 @@ type internal FsiDynamicCompiler( tcGlobals, Some prefixPath, tcState, - StopProcessingExiter(), - (fun _ -> CapturingDiagnosticsLogger("FsiProcessInputsLogger")), + eagerFormat, inputs) ) diff --git a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs index a75900b1c26..abfa2d2bbdb 100644 --- a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs +++ b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs @@ -24,21 +24,21 @@ type internal InProcDiagnosticsLoggerProvider() = let warnings = ResizeArray() member _.Provider = - { new DiagnosticsLoggerProvider() with + { new DiagnosticsLoggerProvider with - member _.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) = + member _.CreateLogger(tcConfigB, exiter) = - { new DiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter, "InProcCompilerDiagnosticsLoggerUpToMaxErrors") with + { new DiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter, "InProcCompilerDiagnosticsLoggerUpToMaxErrors") with member _.HandleTooManyErrors text = warnings.Add(FormattedDiagnostic.Short(FSharpDiagnosticSeverity.Warning, text)) - member _.HandleIssue(tcConfigBuilder, err, severity) = + member _.HandleIssue(tcConfigB, 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 diagnostics = CollectFormattedDiagnostics - (tcConfigBuilder.implicitIncludeDir, tcConfigBuilder.showFullPaths, - tcConfigBuilder.flatErrors, tcConfigBuilder.diagnosticStyle, severity, err, true) + (tcConfigB.implicitIncludeDir, tcConfigB.showFullPaths, + tcConfigB.flatErrors, tcConfigB.diagnosticStyle, severity, err, true) match severity with | FSharpDiagnosticSeverity.Error -> errors.AddRange(diagnostics) diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index 026aeacdb20..4d046e57d38 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -86,13 +86,9 @@ module CompileHelpers = let diagnostics = ResizeArray<_>() let diagnosticSink isError exn = - let main, related = SplitRelatedDiagnostics exn + let diag = StripRelatedDiagnostics exn - let oneDiagnostic e = - diagnostics.Add(FSharpDiagnostic.CreateFromException(e, isError, range0, true)) // Suggest names for errors - - oneDiagnostic main - List.iter oneDiagnostic related + diagnostics.Add(FSharpDiagnostic.CreateFromException(diag, isError, range0, true)) // Suggest names for errors let diagnosticsLogger = { new DiagnosticsLogger("CompileAPI") with @@ -106,8 +102,8 @@ module CompileHelpers = } let loggerProvider = - { new DiagnosticsLoggerProvider() with - member _.CreateDiagnosticsLoggerUpToMaxErrors(_tcConfigBuilder, _exiter) = diagnosticsLogger + { new DiagnosticsLoggerProvider with + member _.CreateLogger(_tcConfigB, _exiter) = diagnosticsLogger } diagnostics, diagnosticsLogger, loggerProvider diff --git a/src/Compiler/Symbols/FSharpDiagnostic.fs b/src/Compiler/Symbols/FSharpDiagnostic.fs index afd6a9c634f..2d90a1dd1c2 100644 --- a/src/Compiler/Symbols/FSharpDiagnostic.fs +++ b/src/Compiler/Symbols/FSharpDiagnostic.fs @@ -190,21 +190,15 @@ module DiagnosticHelpers = ReportDiagnosticAsWarning options (diagnostic, severity) || ReportDiagnosticAsInfo options (diagnostic, severity) then - let oneDiagnostic diagnostic = - [ // 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 diagnostic = FSharpDiagnostic.CreateFromExceptionAndAdjustEof (diagnostic, severity, fallbackRange, fileInfo, suggestNames) - let fileName = diagnostic.Range.FileName - if allErrors || fileName = mainInputFileName || fileName = TcGlobals.DummyFileNameForRangesWithoutASpecificLocation then - yield diagnostic ] - - let mainDiagnostic, relatedDiagnostics = SplitRelatedDiagnostics diagnostic - - yield! oneDiagnostic mainDiagnostic - - for e in relatedDiagnostics do - yield! oneDiagnostic e ] + let diagnostic = StripRelatedDiagnostics diagnostic + + // 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 diagnostic = FSharpDiagnostic.CreateFromExceptionAndAdjustEof (diagnostic, severity, fallbackRange, fileInfo, suggestNames) + let fileName = diagnostic.Range.FileName + if allErrors || fileName = mainInputFileName || fileName = TcGlobals.DummyFileNameForRangesWithoutASpecificLocation then + yield diagnostic ] let CreateDiagnostics (options, allErrors, mainInputFileName, diagnostics, suggestNames) = let fileInfo = (Int32.MaxValue, Int32.MaxValue) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/InferenceProcedures/RecursiveSafetyAnalysis/RecursiveSafetyAnalysis.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/InferenceProcedures/RecursiveSafetyAnalysis/RecursiveSafetyAnalysis.fs index f75ee8440a2..39ad13a3e9e 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/InferenceProcedures/RecursiveSafetyAnalysis/RecursiveSafetyAnalysis.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/InferenceProcedures/RecursiveSafetyAnalysis/RecursiveSafetyAnalysis.fs @@ -25,7 +25,7 @@ module RecursiveSafetyAnalysis = |> shouldFail |> withDiagnostics [ (Error 953, Line 6, Col 6, Line 6, Col 15, "This type definition involves an immediate cyclic reference through an abbreviation") - (Error 1, Line 8, Col 25, Line 8, Col 34, "This expression was expected to have type\n 'bogusType' \nbut here has type\n 'Map<'a,'b>' ") + (Error 1, Line 8, Col 25, Line 8, Col 34, "This expression was expected to have type 'bogusType' but here has type 'Map<'a,'b>'") ] // SOURCE=E_DuplicateRecursiveRecords.fs SCFLAGS="--test:ErrorRanges" # E_DuplicateRecursiveRecords.fs diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index 2d24d2f678a..b871032a23b 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -1128,7 +1128,7 @@ module rec Compiler = (sourceErrors, expectedErrors) ||> List.iter2 (fun actual expected -> - Assert.AreEqual(actual, expected, $"Mismatched error message:\nExpecting: {expected}\nActual: {actual}\n")) + Assert.AreEqual(expected, actual, $"Mismatched error message:\nExpecting: {expected}\nActual: {actual}\n")) let adjust (adjust: int) (result: CompilationResult) : CompilationResult = match result with @@ -1167,18 +1167,16 @@ module rec Compiler = withResults [expectedResult] result let withDiagnostics (expected: (ErrorType * Line * Col * Line * Col * string) list) (result: CompilationResult) : CompilationResult = - let (expectedResults: ErrorInfo list) = - expected |> - List.map( - fun e -> - let (error, (Line startLine), (Col startCol), (Line endLine), (Col endCol), message) = e + let expectedResults: ErrorInfo list = + [ for e in expected do + let (error, Line startLine, Col startCol, Line endLine, Col endCol, message) = e { Error = error Range = { StartLine = startLine StartColumn = startCol EndLine = endLine EndColumn = endCol } - Message = message }) + Message = message } ] withResults expectedResults result let withSingleDiagnostic (expected: (ErrorType * Line * Col * Line * Col * string)) (result: CompilationResult) : CompilationResult = From a5762663b0fd45e586fd42cd0bb4b230ad008ee2 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 24 Aug 2022 01:10:41 +0100 Subject: [PATCH 07/33] format code --- src/Compiler/Driver/CompilerDiagnostics.fs | 16 +++---- src/Compiler/Driver/CompilerDiagnostics.fsi | 3 +- src/Compiler/Driver/ParseAndCheckInputs.fs | 45 +++---------------- src/Compiler/Driver/fsc.fs | 49 +++++---------------- src/Compiler/Driver/fsc.fsi | 3 +- 5 files changed, 28 insertions(+), 88 deletions(-) diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index 7441d4b80eb..b22c1a8ac13 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -384,23 +384,23 @@ let IsWarningOrInfoEnabled (diagnostic, severity) n level specificWarnOn = || (severity = FSharpDiagnosticSeverity.Warning && level >= GetWarningLevel diagnostic) -let ToPhased phase exn = - { - Exception = exn - Phase = phase - } +let ToPhased phase exn = { Exception = exn; Phase = phase } let rec StripRelatedException phase exn = match exn with | ErrorFromAddingTypeEquation (g, denv, ty1, ty2, exn2, m) -> let diag2 = StripRelatedException phase exn2 - ErrorFromAddingTypeEquation(g, denv, ty1, ty2, diag2.Exception, m) |> ToPhased phase + + ErrorFromAddingTypeEquation(g, denv, ty1, ty2, diag2.Exception, m) + |> ToPhased phase | ErrorFromApplyingDefault (g, denv, tp, defaultType, exn2, m) -> let diag2 = StripRelatedException phase exn2 + ErrorFromApplyingDefault(g, denv, tp, defaultType, diag2.Exception, m) |> ToPhased phase | ErrorsFromAddingSubsumptionConstraint (g, denv, ty1, ty2, exn2, contextInfo, m) -> let diag2 = StripRelatedException phase exn2 + ErrorsFromAddingSubsumptionConstraint(g, denv, ty1, ty2, diag2.Exception, contextInfo, m) |> ToPhased phase | ErrorFromAddingConstraint (x, exn2, m) -> @@ -413,8 +413,7 @@ let rec StripRelatedException phase exn = | :? TargetInvocationException as exn -> StripRelatedException phase exn.InnerException | _ -> ToPhased phase exn -let StripRelatedDiagnostics (diagnostic: PhasedDiagnostic) = - StripRelatedException diagnostic.Phase diagnostic.Exception +let StripRelatedDiagnostics (diagnostic: PhasedDiagnostic) = StripRelatedException diagnostic.Phase diagnostic.Exception let Message (name, format) = DeclareResourceString(name, format) @@ -1893,6 +1892,7 @@ let EagerlyFormatDiagnostic (flattenErrors: bool) (suggestNames: bool) (diagnost let os = StringBuilder() OutputPhasedDiagnostic os diagnostic flattenErrors suggestNames let message = os.ToString() + DiagnosticWithText(GetDiagnosticNumber diagnostic, message, m) |> ToPhased diagnostic.Phase | None -> diagnostic diff --git a/src/Compiler/Driver/CompilerDiagnostics.fsi b/src/Compiler/Driver/CompilerDiagnostics.fsi index 84eed299daa..9e8fb1e53b6 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fsi +++ b/src/Compiler/Driver/CompilerDiagnostics.fsi @@ -59,7 +59,8 @@ val GetDiagnosticNumber: diagnostic: PhasedDiagnostic -> int val StripRelatedDiagnostics: diagnostic: PhasedDiagnostic -> PhasedDiagnostic /// Eagerly format a PhasedDiagnostic to a DiagnosticWithText -val EagerlyFormatDiagnostic: flattenErrors: bool -> suggestNames: bool -> diagnostic: PhasedDiagnostic -> PhasedDiagnostic +val EagerlyFormatDiagnostic: + flattenErrors: bool -> suggestNames: bool -> diagnostic: PhasedDiagnostic -> PhasedDiagnostic /// Output an error to a buffer val OutputPhasedDiagnostic: diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index db45b3593ab..ae58312fc98 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -743,7 +743,8 @@ let UseMultipleDiagnosticLoggers (inputs, diagnosticsLogger, eagerFormat) f = // Check input files and create delayed error loggers before we try to parallel parse. let delayLoggers = - inputs |> List.map (fun _ -> CapturingDiagnosticsLogger("TcDiagnosticsLogger", ?eagerFormat=eagerFormat)) + inputs + |> List.map (fun _ -> CapturingDiagnosticsLogger("TcDiagnosticsLogger", ?eagerFormat = eagerFormat)) try f (List.zip inputs delayLoggers) @@ -751,14 +752,7 @@ let UseMultipleDiagnosticLoggers (inputs, diagnosticsLogger, eagerFormat) f = for logger in delayLoggers do logger.CommitDelayedDiagnostics diagnosticsLogger -let ParseInputFilesInParallel - ( - tcConfig: TcConfig, - lexResourceManager, - sourceFiles, - delayLogger: DiagnosticsLogger, - retryLocked - ) = +let ParseInputFilesInParallel (tcConfig: TcConfig, lexResourceManager, sourceFiles, delayLogger: DiagnosticsLogger, retryLocked) = let isLastCompiland, isExe = sourceFiles |> tcConfig.ComputeCanContainEntryPoint @@ -803,13 +797,7 @@ let ParseInputFiles ) = try if tcConfig.concurrentBuild then - ParseInputFilesInParallel( - tcConfig, - lexResourceManager, - sourceFiles, - diagnosticsLogger, - retryLocked - ) + ParseInputFilesInParallel(tcConfig, lexResourceManager, sourceFiles, diagnosticsLogger, retryLocked) else ParseInputFilesSequential(tcConfig, lexResourceManager, sourceFiles, diagnosticsLogger, retryLocked) @@ -1565,18 +1553,7 @@ let CheckMultipleInputsInParallel finishedResults, tcState) -let CheckClosedInputSet - ( - ctok, - checkForErrors, - tcConfig: TcConfig, - tcImports, - tcGlobals, - prefixPathOpt, - tcState, - eagerFormat, - inputs - ) = +let CheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, eagerFormat, inputs) = let disableParallel = Environment.GetEnvironmentVariable("FSHARP_NO_PARALLEL_CHECKING") @@ -1586,17 +1563,7 @@ let CheckClosedInputSet // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions let results, tcState = if tcConfig.concurrentBuild && not disableParallel then - CheckMultipleInputsInParallel( - ctok, - checkForErrors, - tcConfig, - tcImports, - tcGlobals, - prefixPathOpt, - tcState, - eagerFormat, - inputs - ) + CheckMultipleInputsInParallel(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, eagerFormat, inputs) else CheckMultipleInputsSequential(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 9cca72565a4..853904eb3fc 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -121,7 +121,6 @@ let ConsoleDiagnosticsLogger (tcConfigB: TcConfigBuilder, exiter: Exiter) = } :> DiagnosticsLogger - /// DiagnosticLoggers can be sensitive to the TcConfig flags. During the checking /// of the flags themselves we have to create temporary loggers, until the full configuration is /// available. @@ -133,8 +132,7 @@ type CapturingDiagnosticsLogger with /// Commit the delayed diagnostics via a fresh temporary logger of the right kind. member x.CommitDelayedDiagnostics(diagnosticsLoggerProvider: DiagnosticsLoggerProvider, tcConfigB, exiter) = - let diagnosticsLogger = - diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter) + let diagnosticsLogger = diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter) x.CommitDelayedDiagnostics diagnosticsLogger /// The default DiagnosticsLogger implementation, reporting messages to the Console up to the maxerrors maximum @@ -519,8 +517,7 @@ let main1 SetTailcallSwitch tcConfigB OptionSwitch.On // Now install a delayed logger to hold all errors from flags until after all flags have been parsed (for example, --vserrors) - let delayForFlagsLogger = - CapturingDiagnosticsLogger("DelayFlagsLogger") + let delayForFlagsLogger = CapturingDiagnosticsLogger("DelayFlagsLogger") let _holder = UseDiagnosticsLogger delayForFlagsLogger @@ -539,7 +536,7 @@ let main1 AdjustForScriptCompile(tcConfigB, files, lexResourceManager, dependencyProvider) with e -> errorRecovery e rangeStartup - delayForFlagsLogger.CommitDelayedDiagnostics (diagnosticsLoggerProvider, tcConfigB, exiter) + delayForFlagsLogger.CommitDelayedDiagnostics(diagnosticsLoggerProvider, tcConfigB, exiter) exiter.Exit 1 tcConfigB.conditionalDefines <- "COMPILED" :: tcConfigB.conditionalDefines @@ -554,12 +551,12 @@ let main1 tcConfigB.DecideNames sourceFiles with e -> errorRecovery e rangeStartup - delayForFlagsLogger.CommitDelayedDiagnostics (diagnosticsLoggerProvider, tcConfigB, exiter) + delayForFlagsLogger.CommitDelayedDiagnostics(diagnosticsLoggerProvider, tcConfigB, exiter) exiter.Exit 1 // DecideNames may give "no inputs" error. Abort on error at this point. bug://3911 if not tcConfigB.continueAfterParseFailure && delayForFlagsLogger.ErrorCount > 0 then - delayForFlagsLogger.CommitDelayedDiagnostics (diagnosticsLoggerProvider, tcConfigB, exiter) + delayForFlagsLogger.CommitDelayedDiagnostics(diagnosticsLoggerProvider, tcConfigB, exiter) exiter.Exit 1 // If there's a problem building TcConfig, abort @@ -568,11 +565,10 @@ let main1 TcConfig.Create(tcConfigB, validate = false) with e -> errorRecovery e rangeStartup - delayForFlagsLogger.CommitDelayedDiagnostics (diagnosticsLoggerProvider, tcConfigB, exiter) + delayForFlagsLogger.CommitDelayedDiagnostics(diagnosticsLoggerProvider, tcConfigB, exiter) exiter.Exit 1 - let diagnosticsLogger = - diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter) + let diagnosticsLogger = diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter) // Install the global error logger and never remove it. This logger does have all command-line flags considered. let _holder = UseDiagnosticsLogger diagnosticsLogger @@ -665,18 +661,7 @@ let main1 let inputs = inputs |> List.map fst let tcState, topAttrs, typedAssembly, _tcEnvAtEnd = - TypeCheck( - ctok, - tcConfig, - tcImports, - tcGlobals, - diagnosticsLogger, - assemblyName, - tcEnv0, - openDecls0, - inputs, - exiter - ) + TypeCheck(ctok, tcConfig, tcImports, tcGlobals, diagnosticsLogger, assemblyName, tcEnv0, openDecls0, inputs, exiter) AbortOnError(diagnosticsLogger, exiter) ReportTime tcConfig "Typechecked" @@ -790,13 +775,12 @@ let main1OfAst try TcConfig.Create(tcConfigB, validate = false) with e -> - delayForFlagsLogger.CommitDelayedDiagnostics (diagnosticsLoggerProvider, tcConfigB, exiter) + delayForFlagsLogger.CommitDelayedDiagnostics(diagnosticsLoggerProvider, tcConfigB, exiter) exiter.Exit 1 let dependencyProvider = new DependencyProvider() - let diagnosticsLogger = - diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter) + let diagnosticsLogger = diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter) // Install the global error logger and never remove it. This logger does have all command-line flags considered. let _holder = UseDiagnosticsLogger diagnosticsLogger @@ -848,18 +832,7 @@ let main1OfAst // Type check the inputs let tcState, topAttrs, typedAssembly, _tcEnvAtEnd = - TypeCheck( - ctok, - tcConfig, - tcImports, - tcGlobals, - diagnosticsLogger, - assemblyName, - tcEnv0, - openDecls0, - inputs, - exiter - ) + TypeCheck(ctok, tcConfig, tcImports, tcGlobals, diagnosticsLogger, assemblyName, tcEnv0, openDecls0, inputs, exiter) AbortOnError(diagnosticsLogger, exiter) ReportTime tcConfig "Typechecked" diff --git a/src/Compiler/Driver/fsc.fsi b/src/Compiler/Driver/fsc.fsi index 57ec172fa57..79f8f534185 100644 --- a/src/Compiler/Driver/fsc.fsi +++ b/src/Compiler/Driver/fsc.fsi @@ -17,8 +17,7 @@ open FSharp.Compiler.TcGlobals /// of the flags themselves we have to create temporary loggers, until the full configuration is /// available. type DiagnosticsLoggerProvider = - abstract CreateLogger: - tcConfigB: TcConfigBuilder * exiter: Exiter -> DiagnosticsLogger + abstract CreateLogger: tcConfigB: TcConfigBuilder * exiter: Exiter -> DiagnosticsLogger /// The default DiagnosticsLoggerProvider implementation, reporting messages to the Console up to the maxerrors maximum type ConsoleLoggerProvider = From 3f2574fee1a51fae08448c92d223b3ffd5f77ef8 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 24 Aug 2022 01:13:11 +0100 Subject: [PATCH 08/33] remove SplitRelatedDiagnostic --- src/Compiler/Driver/CompilerDiagnostics.fs | 32 ++------------------- src/Compiler/Driver/CompilerDiagnostics.fsi | 5 ---- src/Compiler/Service/service.fs | 8 ++---- src/Compiler/Symbols/FSharpDiagnostic.fs | 2 -- 4 files changed, 5 insertions(+), 42 deletions(-) diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index b22c1a8ac13..4bf7169c026 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -386,35 +386,6 @@ let IsWarningOrInfoEnabled (diagnostic, severity) n level specificWarnOn = let ToPhased phase exn = { Exception = exn; Phase = phase } -let rec StripRelatedException phase exn = - match exn with - | ErrorFromAddingTypeEquation (g, denv, ty1, ty2, exn2, m) -> - let diag2 = StripRelatedException phase exn2 - - ErrorFromAddingTypeEquation(g, denv, ty1, ty2, diag2.Exception, m) - |> ToPhased phase - | ErrorFromApplyingDefault (g, denv, tp, defaultType, exn2, m) -> - let diag2 = StripRelatedException phase exn2 - - ErrorFromApplyingDefault(g, denv, tp, defaultType, diag2.Exception, m) - |> ToPhased phase - | ErrorsFromAddingSubsumptionConstraint (g, denv, ty1, ty2, exn2, contextInfo, m) -> - let diag2 = StripRelatedException phase exn2 - - ErrorsFromAddingSubsumptionConstraint(g, denv, ty1, ty2, diag2.Exception, contextInfo, m) - |> ToPhased phase - | ErrorFromAddingConstraint (x, exn2, m) -> - let diag2 = StripRelatedException phase exn2 - ErrorFromAddingConstraint(x, diag2.Exception, m) |> ToPhased phase - | WrappedError (exn2, m) -> - let diag2 = StripRelatedException phase exn2 - WrappedError(diag2.Exception, m) |> ToPhased phase - // Strip TargetInvocationException wrappers - | :? TargetInvocationException as exn -> StripRelatedException phase exn.InnerException - | _ -> ToPhased phase exn - -let StripRelatedDiagnostics (diagnostic: PhasedDiagnostic) = StripRelatedException diagnostic.Phase diagnostic.Exception - let Message (name, format) = DeclareResourceString(name, format) do FSComp.SR.RunStartupValidation() @@ -1890,11 +1861,14 @@ let EagerlyFormatDiagnostic (flattenErrors: bool) (suggestNames: bool) (diagnost match GetRangeOfDiagnostic diagnostic with | Some m -> let os = StringBuilder() + OutputPhasedDiagnostic os diagnostic flattenErrors suggestNames + let message = os.ToString() DiagnosticWithText(GetDiagnosticNumber diagnostic, message, m) |> ToPhased diagnostic.Phase + | None -> diagnostic let SanitizeFileName fileName implicitIncludeDir = diff --git a/src/Compiler/Driver/CompilerDiagnostics.fsi b/src/Compiler/Driver/CompilerDiagnostics.fsi index 9e8fb1e53b6..bbfb0d27fea 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fsi +++ b/src/Compiler/Driver/CompilerDiagnostics.fsi @@ -53,11 +53,6 @@ val GetRangeOfDiagnostic: diagnostic: PhasedDiagnostic -> range option /// Get the number associated with an error val GetDiagnosticNumber: diagnostic: PhasedDiagnostic -> int -/// Rewrite a diagnostic stripping TargetInvocationException from any exceptions inside it -/// -/// TODO: this routine probably isn't necessary -val StripRelatedDiagnostics: diagnostic: PhasedDiagnostic -> PhasedDiagnostic - /// Eagerly format a PhasedDiagnostic to a DiagnosticWithText val EagerlyFormatDiagnostic: flattenErrors: bool -> suggestNames: bool -> diagnostic: PhasedDiagnostic -> PhasedDiagnostic diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index 4d046e57d38..b60bf55cef3 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -85,15 +85,11 @@ module CompileHelpers = let mkCompilationDiagnosticsHandlers () = let diagnostics = ResizeArray<_>() - let diagnosticSink isError exn = - let diag = StripRelatedDiagnostics exn - - diagnostics.Add(FSharpDiagnostic.CreateFromException(diag, isError, range0, true)) // Suggest names for errors - let diagnosticsLogger = { new DiagnosticsLogger("CompileAPI") with - member _.DiagnosticSink(exn, isError) = diagnosticSink isError exn + member _.DiagnosticSink(diag, isError) = + diagnostics.Add(FSharpDiagnostic.CreateFromException(diag, isError, range0, true)) // Suggest names for errors member _.ErrorCount = diagnostics diff --git a/src/Compiler/Symbols/FSharpDiagnostic.fs b/src/Compiler/Symbols/FSharpDiagnostic.fs index 2d90a1dd1c2..e24fe472b8f 100644 --- a/src/Compiler/Symbols/FSharpDiagnostic.fs +++ b/src/Compiler/Symbols/FSharpDiagnostic.fs @@ -190,8 +190,6 @@ module DiagnosticHelpers = ReportDiagnosticAsWarning options (diagnostic, severity) || ReportDiagnosticAsInfo options (diagnostic, severity) then - let diagnostic = StripRelatedDiagnostics diagnostic - // 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 From e33f028118617e4b8e731921b79c9afdc6dc4816 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 24 Aug 2022 14:23:36 +0100 Subject: [PATCH 09/33] fix build and cleanup --- src/Compiler/Checking/ConstraintSolver.fs | 10 +- src/Compiler/Checking/ConstraintSolver.fsi | 14 +- src/Compiler/Driver/CompilerDiagnostics.fs | 878 ++++++++++---------- src/Compiler/Driver/CompilerDiagnostics.fsi | 38 +- src/Compiler/Driver/fsc.fs | 10 +- src/Compiler/Interactive/fsi.fs | 14 +- src/Compiler/Symbols/FSharpDiagnostic.fs | 22 +- 7 files changed, 490 insertions(+), 496 deletions(-) diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 8feeb65a6a1..c69db854c24 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -244,15 +244,15 @@ exception ConstraintSolverMissingConstraint of displayEnv: DisplayEnv * Typar * exception ConstraintSolverError of string * range * range -exception ErrorFromApplyingDefault of tcGlobals: TcGlobals * displayEnv: DisplayEnv * Typar * TType * exn * range +exception ErrorFromApplyingDefault of tcGlobals: TcGlobals * displayEnv: DisplayEnv * Typar * TType * error: exn * range: range -exception ErrorFromAddingTypeEquation of tcGlobals: TcGlobals * displayEnv: DisplayEnv * actualTy: TType * expectedTy: TType * exn * range +exception ErrorFromAddingTypeEquation of tcGlobals: TcGlobals * displayEnv: DisplayEnv * actualTy: TType * expectedTy: TType * error: exn * range: range -exception ErrorsFromAddingSubsumptionConstraint of tcGlobals: TcGlobals * displayEnv: DisplayEnv * actualTy: TType * expectedTy: TType * exn * ContextInfo * parameterRange: range +exception ErrorsFromAddingSubsumptionConstraint of tcGlobals: TcGlobals * displayEnv: DisplayEnv * actualTy: TType * expectedTy: TType * error: exn * ctxtInfo: ContextInfo * parameterRange: range -exception ErrorFromAddingConstraint of displayEnv: DisplayEnv * exn * range +exception ErrorFromAddingConstraint of displayEnv: DisplayEnv * error: exn * range: range -exception UnresolvedOverloading of displayEnv: DisplayEnv * callerArgs: CallerArgs * failure: OverloadResolutionFailure * range +exception UnresolvedOverloading of displayEnv: DisplayEnv * callerArgs: CallerArgs * failure: OverloadResolutionFailure * range: range exception UnresolvedConversionOperator of displayEnv: DisplayEnv * TType * TType * range diff --git a/src/Compiler/Checking/ConstraintSolver.fsi b/src/Compiler/Checking/ConstraintSolver.fsi index c45db538fc2..c04d808e68b 100644 --- a/src/Compiler/Checking/ConstraintSolver.fsi +++ b/src/Compiler/Checking/ConstraintSolver.fsi @@ -170,33 +170,33 @@ exception ConstraintSolverMissingConstraint of displayEnv: DisplayEnv * Typar * exception ConstraintSolverError of string * range * range -exception ErrorFromApplyingDefault of tcGlobals: TcGlobals * displayEnv: DisplayEnv * Typar * TType * exn * range +exception ErrorFromApplyingDefault of tcGlobals: TcGlobals * displayEnv: DisplayEnv * Typar * TType * error: exn * range: range exception ErrorFromAddingTypeEquation of tcGlobals: TcGlobals * displayEnv: DisplayEnv * actualTy: TType * expectedTy: TType * - exn * - range + error: exn * + range: range exception ErrorsFromAddingSubsumptionConstraint of tcGlobals: TcGlobals * displayEnv: DisplayEnv * actualTy: TType * expectedTy: TType * - exn * - ContextInfo * + error: exn * + ctxtInfo: ContextInfo * parameterRange: range -exception ErrorFromAddingConstraint of displayEnv: DisplayEnv * exn * range +exception ErrorFromAddingConstraint of displayEnv: DisplayEnv * error: exn * range: range exception UnresolvedConversionOperator of displayEnv: DisplayEnv * TType * TType * range exception UnresolvedOverloading of displayEnv: DisplayEnv * callerArgs: CallerArgs * failure: OverloadResolutionFailure * - range + range: range exception NonRigidTypar of displayEnv: DisplayEnv * string option * range * TType * TType * range diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index 4bf7169c026..8eaa46f51a6 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -77,12 +77,13 @@ exception DeprecatedCommandLineOptionNoDescription of string * range /// This exception is an old-style way of reporting a diagnostic exception InternalCommandLineOption of string * range -let GetRangeOfDiagnostic (diagnostic: PhasedDiagnostic) = - let rec RangeFromException exn = +type Exception with + + member exn.DiagnosticRange = match exn with - | ErrorFromAddingConstraint (_, exn2, _) -> RangeFromException exn2 + | ErrorFromAddingConstraint (_, exn2, _) -> exn2.DiagnosticRange #if !NO_TYPEPROVIDERS - | TypeProviders.ProvidedTypeResolutionNoRange exn -> RangeFromException exn + | TypeProviders.ProvidedTypeResolutionNoRange exn -> exn.DiagnosticRange | TypeProviders.ProvidedTypeResolution (m, _) #endif | ReservedKeyword (_, m) @@ -203,17 +204,13 @@ let GetRangeOfDiagnostic (diagnostic: PhasedDiagnostic) = | HashLoadedSourceHasIssues (_, _, _, m) | HashLoadedScriptConsideredSource m -> Some m // Strip TargetInvocationException wrappers - | :? System.Reflection.TargetInvocationException as e -> RangeFromException e.InnerException + | :? System.Reflection.TargetInvocationException as e -> e.InnerException.DiagnosticRange #if !NO_TYPEPROVIDERS | :? TypeProviderError as e -> e.Range |> Some #endif - | _ -> None - RangeFromException diagnostic.Exception - -let GetDiagnosticNumber (diagnostic: PhasedDiagnostic) = - let rec GetFromException (exn: exn) = + member exn.DiagnosticNumber = match exn with // DO NOT CHANGE THESE NUMBERS | ErrorFromAddingTypeEquation _ -> 1 @@ -328,13 +325,10 @@ let GetDiagnosticNumber (diagnostic: PhasedDiagnostic) = | TypeProviders.ProvidedTypeResolution _ -> 103 #endif | PatternMatchCompilation.EnumMatchIncomplete _ -> 104 - // DO NOT CHANGE THE NUMBERS // Strip TargetInvocationException wrappers - | :? System.Reflection.TargetInvocationException as e -> GetFromException e.InnerException - - | WrappedError (e, _) -> GetFromException e - + | :? TargetInvocationException as e -> e.InnerException.DiagnosticNumber + | WrappedError (e, _) -> e.DiagnosticNumber | DiagnosticWithText (n, _, _) -> n | DiagnosticWithSuggestions (n, _, _, _, _) -> n | Failure _ -> 192 @@ -346,241 +340,293 @@ let GetDiagnosticNumber (diagnostic: PhasedDiagnostic) = fst (FSComp.SR.considerUpcast ("", "")) | _ -> 193 - GetFromException diagnostic.Exception -let GetWarningLevel diagnostic = - match diagnostic.Exception with - // Level 5 warnings - | RecursiveUseCheckedAtRuntime _ - | LetRecEvaluatedOutOfOrder _ - | DefensiveCopyWarning _ -> 5 - - | DiagnosticWithText (n, _, _) - | DiagnosticWithSuggestions (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..." - // 1178, tcNoEqualityNeeded2, "The struct, record or union type '%s' does not support structural equality because the type '%s' does not satisfy the 'equality' constraint...." - if (n = 1178) then 5 else 2 - // Level 2 - | _ -> 2 - -let IsWarningOrInfoEnabled (diagnostic, severity) n level specificWarnOn = - List.contains n specificWarnOn - || - // Some specific warnings/informational are never on by default, i.e. unused variable warnings - match n with - | 1182 -> false // chkUnusedValue - off by default - | 3180 -> false // abImplicitHeapAllocation - off by default - | 3186 -> false // pickleMissingDefinition - off by default - | 3366 -> false //tcIndexNotationDeprecated - currently off by default - | 3517 -> false // optFailedToInlineSuggestedValue - off by default - | 3388 -> false // tcSubsumptionImplicitConversionUsed - off by default - | 3389 -> false // tcBuiltInImplicitConversionUsed - off by default - | 3390 -> false // xmlDocBadlyFormed - off by default - | 3395 -> false // tcImplicitConversionUsedForMethodArg - off by default - | _ -> - (severity = FSharpDiagnosticSeverity.Info) - || (severity = FSharpDiagnosticSeverity.Warning - && level >= GetWarningLevel diagnostic) - -let ToPhased phase exn = { Exception = exn; Phase = phase } - -let Message (name, format) = DeclareResourceString(name, format) - -do FSComp.SR.RunStartupValidation() -let SeeAlsoE () = Message("SeeAlso", "%s") -let ConstraintSolverTupleDiffLengthsE () = Message("ConstraintSolverTupleDiffLengths", "%d%d") -let ConstraintSolverInfiniteTypesE () = Message("ConstraintSolverInfiniteTypes", "%s%s") -let ConstraintSolverMissingConstraintE () = Message("ConstraintSolverMissingConstraint", "%s") -let ConstraintSolverTypesNotInEqualityRelation1E () = Message("ConstraintSolverTypesNotInEqualityRelation1", "%s%s") -let ConstraintSolverTypesNotInEqualityRelation2E () = Message("ConstraintSolverTypesNotInEqualityRelation2", "%s%s") -let ConstraintSolverTypesNotInSubsumptionRelationE () = Message("ConstraintSolverTypesNotInSubsumptionRelation", "%s%s%s") -let ErrorFromAddingTypeEquation1E () = Message("ErrorFromAddingTypeEquation1", "%s%s%s") -let ErrorFromAddingTypeEquation2E () = Message("ErrorFromAddingTypeEquation2", "%s%s%s") -let ErrorFromApplyingDefault1E () = Message("ErrorFromApplyingDefault1", "%s") -let ErrorFromApplyingDefault2E () = Message("ErrorFromApplyingDefault2", "") -let ErrorsFromAddingSubsumptionConstraintE () = Message("ErrorsFromAddingSubsumptionConstraint", "%s%s%s") -let UpperCaseIdentifierInPatternE () = Message("UpperCaseIdentifierInPattern", "") -let NotUpperCaseConstructorE () = Message("NotUpperCaseConstructor", "") -let NotUpperCaseConstructorWithoutRQAE () = Message("NotUpperCaseConstructorWithoutRQA", "") -let FunctionExpectedE () = Message("FunctionExpected", "") -let BakedInMemberConstraintNameE () = Message("BakedInMemberConstraintName", "%s") -let BadEventTransformationE () = Message("BadEventTransformation", "") -let ParameterlessStructCtorE () = Message("ParameterlessStructCtor", "") -let InterfaceNotRevealedE () = Message("InterfaceNotRevealed", "%s") -let TyconBadArgsE () = Message("TyconBadArgs", "%s%d%d") -let IndeterminateTypeE () = Message("IndeterminateType", "") -let NameClash1E () = Message("NameClash1", "%s%s") -let NameClash2E () = Message("NameClash2", "%s%s%s%s%s") -let Duplicate1E () = Message("Duplicate1", "%s") -let Duplicate2E () = Message("Duplicate2", "%s%s") -let UndefinedName2E () = Message("UndefinedName2", "") -let FieldNotMutableE () = Message("FieldNotMutable", "") -let FieldsFromDifferentTypesE () = Message("FieldsFromDifferentTypes", "%s%s") -let VarBoundTwiceE () = Message("VarBoundTwice", "%s") -let RecursionE () = Message("Recursion", "%s%s%s%s") -let InvalidRuntimeCoercionE () = Message("InvalidRuntimeCoercion", "%s%s%s") -let IndeterminateRuntimeCoercionE () = Message("IndeterminateRuntimeCoercion", "%s%s") -let IndeterminateStaticCoercionE () = Message("IndeterminateStaticCoercion", "%s%s") -let StaticCoercionShouldUseBoxE () = Message("StaticCoercionShouldUseBox", "%s%s") -let TypeIsImplicitlyAbstractE () = Message("TypeIsImplicitlyAbstract", "") -let NonRigidTypar1E () = Message("NonRigidTypar1", "%s%s") -let NonRigidTypar2E () = Message("NonRigidTypar2", "%s%s") -let NonRigidTypar3E () = Message("NonRigidTypar3", "%s%s") -let OBlockEndSentenceE () = Message("BlockEndSentence", "") -let UnexpectedEndOfInputE () = Message("UnexpectedEndOfInput", "") -let UnexpectedE () = Message("Unexpected", "%s") -let NONTERM_interactionE () = Message("NONTERM.interaction", "") -let NONTERM_hashDirectiveE () = Message("NONTERM.hashDirective", "") -let NONTERM_fieldDeclE () = Message("NONTERM.fieldDecl", "") -let NONTERM_unionCaseReprE () = Message("NONTERM.unionCaseRepr", "") -let NONTERM_localBindingE () = Message("NONTERM.localBinding", "") -let NONTERM_hardwhiteLetBindingsE () = Message("NONTERM.hardwhiteLetBindings", "") -let NONTERM_classDefnMemberE () = Message("NONTERM.classDefnMember", "") -let NONTERM_defnBindingsE () = Message("NONTERM.defnBindings", "") -let NONTERM_classMemberSpfnE () = Message("NONTERM.classMemberSpfn", "") -let NONTERM_valSpfnE () = Message("NONTERM.valSpfn", "") -let NONTERM_tyconSpfnE () = Message("NONTERM.tyconSpfn", "") -let NONTERM_anonLambdaExprE () = Message("NONTERM.anonLambdaExpr", "") -let NONTERM_attrUnionCaseDeclE () = Message("NONTERM.attrUnionCaseDecl", "") -let NONTERM_cPrototypeE () = Message("NONTERM.cPrototype", "") -let NONTERM_objectImplementationMembersE () = Message("NONTERM.objectImplementationMembers", "") -let NONTERM_ifExprCasesE () = Message("NONTERM.ifExprCases", "") -let NONTERM_openDeclE () = Message("NONTERM.openDecl", "") -let NONTERM_fileModuleSpecE () = Message("NONTERM.fileModuleSpec", "") -let NONTERM_patternClausesE () = Message("NONTERM.patternClauses", "") -let NONTERM_beginEndExprE () = Message("NONTERM.beginEndExpr", "") -let NONTERM_recdExprE () = Message("NONTERM.recdExpr", "") -let NONTERM_tyconDefnE () = Message("NONTERM.tyconDefn", "") -let NONTERM_exconCoreE () = Message("NONTERM.exconCore", "") -let NONTERM_typeNameInfoE () = Message("NONTERM.typeNameInfo", "") -let NONTERM_attributeListE () = Message("NONTERM.attributeList", "") -let NONTERM_quoteExprE () = Message("NONTERM.quoteExpr", "") -let NONTERM_typeConstraintE () = Message("NONTERM.typeConstraint", "") -let NONTERM_Category_ImplementationFileE () = Message("NONTERM.Category.ImplementationFile", "") -let NONTERM_Category_DefinitionE () = Message("NONTERM.Category.Definition", "") -let NONTERM_Category_SignatureFileE () = Message("NONTERM.Category.SignatureFile", "") -let NONTERM_Category_PatternE () = Message("NONTERM.Category.Pattern", "") -let NONTERM_Category_ExprE () = Message("NONTERM.Category.Expr", "") -let NONTERM_Category_TypeE () = Message("NONTERM.Category.Type", "") -let NONTERM_typeArgsActualE () = Message("NONTERM.typeArgsActual", "") -let TokenName1E () = Message("TokenName1", "%s") -let TokenName1TokenName2E () = Message("TokenName1TokenName2", "%s%s") -let TokenName1TokenName2TokenName3E () = Message("TokenName1TokenName2TokenName3", "%s%s%s") -let RuntimeCoercionSourceSealed1E () = Message("RuntimeCoercionSourceSealed1", "%s") -let RuntimeCoercionSourceSealed2E () = Message("RuntimeCoercionSourceSealed2", "%s") -let CoercionTargetSealedE () = Message("CoercionTargetSealed", "%s") -let UpcastUnnecessaryE () = Message("UpcastUnnecessary", "") -let TypeTestUnnecessaryE () = Message("TypeTestUnnecessary", "") -let OverrideDoesntOverride1E () = Message("OverrideDoesntOverride1", "%s") -let OverrideDoesntOverride2E () = Message("OverrideDoesntOverride2", "%s") -let OverrideDoesntOverride3E () = Message("OverrideDoesntOverride3", "%s") -let OverrideDoesntOverride4E () = Message("OverrideDoesntOverride4", "%s") -let UnionCaseWrongArgumentsE () = Message("UnionCaseWrongArguments", "%d%d") -let UnionPatternsBindDifferentNamesE () = Message("UnionPatternsBindDifferentNames", "") -let RequiredButNotSpecifiedE () = Message("RequiredButNotSpecified", "%s%s%s") -let UseOfAddressOfOperatorE () = Message("UseOfAddressOfOperator", "") -let DefensiveCopyWarningE () = Message("DefensiveCopyWarning", "%s") -let DeprecatedThreadStaticBindingWarningE () = Message("DeprecatedThreadStaticBindingWarning", "") -let FunctionValueUnexpectedE () = Message("FunctionValueUnexpected", "%s") -let UnitTypeExpectedE () = Message("UnitTypeExpected", "%s") -let UnitTypeExpectedWithEqualityE () = Message("UnitTypeExpectedWithEquality", "%s") -let UnitTypeExpectedWithPossiblePropertySetterE () = Message("UnitTypeExpectedWithPossiblePropertySetter", "%s%s%s") -let UnitTypeExpectedWithPossibleAssignmentE () = Message("UnitTypeExpectedWithPossibleAssignment", "%s%s") -let UnitTypeExpectedWithPossibleAssignmentToMutableE () = Message("UnitTypeExpectedWithPossibleAssignmentToMutable", "%s%s") -let RecursiveUseCheckedAtRuntimeE () = Message("RecursiveUseCheckedAtRuntime", "") -let LetRecUnsound1E () = Message("LetRecUnsound1", "%s") -let LetRecUnsound2E () = Message("LetRecUnsound2", "%s%s") -let LetRecUnsoundInnerE () = Message("LetRecUnsoundInner", "%s") -let LetRecEvaluatedOutOfOrderE () = Message("LetRecEvaluatedOutOfOrder", "") -let LetRecCheckedAtRuntimeE () = Message("LetRecCheckedAtRuntime", "") -let SelfRefObjCtor1E () = Message("SelfRefObjCtor1", "") -let SelfRefObjCtor2E () = Message("SelfRefObjCtor2", "") -let VirtualAugmentationOnNullValuedTypeE () = Message("VirtualAugmentationOnNullValuedType", "") -let NonVirtualAugmentationOnNullValuedTypeE () = Message("NonVirtualAugmentationOnNullValuedType", "") -let NonUniqueInferredAbstractSlot1E () = Message("NonUniqueInferredAbstractSlot1", "%s") -let NonUniqueInferredAbstractSlot2E () = Message("NonUniqueInferredAbstractSlot2", "") -let NonUniqueInferredAbstractSlot3E () = Message("NonUniqueInferredAbstractSlot3", "%s%s") -let NonUniqueInferredAbstractSlot4E () = Message("NonUniqueInferredAbstractSlot4", "") -let Failure3E () = Message("Failure3", "%s") -let Failure4E () = Message("Failure4", "%s") -let MatchIncomplete1E () = Message("MatchIncomplete1", "") -let MatchIncomplete2E () = Message("MatchIncomplete2", "%s") -let MatchIncomplete3E () = Message("MatchIncomplete3", "%s") -let MatchIncomplete4E () = Message("MatchIncomplete4", "") -let RuleNeverMatchedE () = Message("RuleNeverMatched", "") -let EnumMatchIncomplete1E () = Message("EnumMatchIncomplete1", "") -let ValNotMutableE () = Message("ValNotMutable", "%s") -let ValNotLocalE () = Message("ValNotLocal", "") -let Obsolete1E () = Message("Obsolete1", "") -let Obsolete2E () = Message("Obsolete2", "%s") -let ExperimentalE () = Message("Experimental", "%s") -let PossibleUnverifiableCodeE () = Message("PossibleUnverifiableCode", "") -let DeprecatedE () = Message("Deprecated", "%s") -let LibraryUseOnlyE () = Message("LibraryUseOnly", "") -let MissingFieldsE () = Message("MissingFields", "%s") -let ValueRestriction1E () = Message("ValueRestriction1", "%s%s%s") -let ValueRestriction2E () = Message("ValueRestriction2", "%s%s%s") -let ValueRestriction3E () = Message("ValueRestriction3", "%s") -let ValueRestriction4E () = Message("ValueRestriction4", "%s%s%s") -let ValueRestriction5E () = Message("ValueRestriction5", "%s%s%s") -let RecoverableParseErrorE () = Message("RecoverableParseError", "") -let ReservedKeywordE () = Message("ReservedKeyword", "%s") -let IndentationProblemE () = Message("IndentationProblem", "%s") -let OverrideInIntrinsicAugmentationE () = Message("OverrideInIntrinsicAugmentation", "") -let OverrideInExtrinsicAugmentationE () = Message("OverrideInExtrinsicAugmentation", "") -let IntfImplInIntrinsicAugmentationE () = Message("IntfImplInIntrinsicAugmentation", "") -let IntfImplInExtrinsicAugmentationE () = Message("IntfImplInExtrinsicAugmentation", "") -let UnresolvedReferenceNoRangeE () = Message("UnresolvedReferenceNoRange", "%s") -let UnresolvedPathReferenceNoRangeE () = Message("UnresolvedPathReferenceNoRange", "%s%s") -let HashIncludeNotAllowedInNonScriptE () = Message("HashIncludeNotAllowedInNonScript", "") -let HashReferenceNotAllowedInNonScriptE () = Message("HashReferenceNotAllowedInNonScript", "") -let HashDirectiveNotAllowedInNonScriptE () = Message("HashDirectiveNotAllowedInNonScript", "") -let FileNameNotResolvedE () = Message("FileNameNotResolved", "%s%s") -let AssemblyNotResolvedE () = Message("AssemblyNotResolved", "%s") -let HashLoadedSourceHasIssues0E () = Message("HashLoadedSourceHasIssues0", "") -let HashLoadedSourceHasIssues1E () = Message("HashLoadedSourceHasIssues1", "") -let HashLoadedSourceHasIssues2E () = Message("HashLoadedSourceHasIssues2", "") -let HashLoadedScriptConsideredSourceE () = Message("HashLoadedScriptConsideredSource", "") -let InvalidInternalsVisibleToAssemblyName1E () = Message("InvalidInternalsVisibleToAssemblyName1", "%s%s") -let InvalidInternalsVisibleToAssemblyName2E () = Message("InvalidInternalsVisibleToAssemblyName2", "%s") -let LoadedSourceNotFoundIgnoringE () = Message("LoadedSourceNotFoundIgnoring", "%s") -let MSBuildReferenceResolutionErrorE () = Message("MSBuildReferenceResolutionError", "%s%s") -let TargetInvocationExceptionWrapperE () = Message("TargetInvocationExceptionWrapper", "%s") +type PhasedDiagnostic with + member x.Range = + x.Exception.DiagnosticRange + + member x.Number = + x.Exception.DiagnosticNumber + + member x.WarningLevel = + match x.Exception with + // Level 5 warnings + | RecursiveUseCheckedAtRuntime _ + | LetRecEvaluatedOutOfOrder _ + | DefensiveCopyWarning _ -> 5 + + | DiagnosticWithText (n, _, _) + | DiagnosticWithSuggestions (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..." + // 1178, tcNoEqualityNeeded2, "The struct, record or union type '%s' does not support structural equality because the type '%s' does not satisfy the 'equality' constraint...." + if (n = 1178) then 5 else 2 + // Level 2 + | _ -> 2 + + member x.IsEnabled (severity, options) = + let level = options.WarnLevel + let specificWarnOn = options.WarnOn + let n = x.Number + List.contains n specificWarnOn + || + // Some specific warnings/informational are never on by default, i.e. unused variable warnings + match n with + | 1182 -> false // chkUnusedValue - off by default + | 3180 -> false // abImplicitHeapAllocation - off by default + | 3186 -> false // pickleMissingDefinition - off by default + | 3366 -> false //tcIndexNotationDeprecated - currently off by default + | 3517 -> false // optFailedToInlineSuggestedValue - off by default + | 3388 -> false // tcSubsumptionImplicitConversionUsed - off by default + | 3389 -> false // tcBuiltInImplicitConversionUsed - off by default + | 3390 -> false // xmlDocBadlyFormed - off by default + | 3395 -> false // tcImplicitConversionUsedForMethodArg - off by default + | _ -> + (severity = FSharpDiagnosticSeverity.Info) + || (severity = FSharpDiagnosticSeverity.Warning + && level >= x.WarningLevel) + + member x.ReportAsInfo (options, severity) = + match severity with + | FSharpDiagnosticSeverity.Error -> false + | FSharpDiagnosticSeverity.Warning -> false + | FSharpDiagnosticSeverity.Info -> + x.IsEnabled (severity, options) + && not (List.contains x.Number options.WarnOff) + | FSharpDiagnosticSeverity.Hidden -> false + + member x.ReportAsWarning (options, severity) = + match severity with + | FSharpDiagnosticSeverity.Error -> false + + | FSharpDiagnosticSeverity.Warning -> + x.IsEnabled (severity, options) + && not (List.contains x.Number options.WarnOff) + + // Informational become warning if explicitly on and not explicitly off + | FSharpDiagnosticSeverity.Info -> + let n = x.Number + List.contains n options.WarnOn && not (List.contains n options.WarnOff) + + | FSharpDiagnosticSeverity.Hidden -> false + + member x.ReportAsError (options, severity) = + + match severity with + | FSharpDiagnosticSeverity.Error -> true + + // Warnings become errors in some situations + | FSharpDiagnosticSeverity.Warning -> + let n = x.Number + x.IsEnabled (severity, options) + && not (List.contains n options.WarnAsWarn) + && ((options.GlobalWarnAsError && not (List.contains n options.WarnOff)) + || List.contains n options.WarnAsError) + + // Informational become errors if explicitly WarnAsError + | FSharpDiagnosticSeverity.Info -> + List.contains x.Number options.WarnAsError + + | FSharpDiagnosticSeverity.Hidden -> false + + +[] +module OldStyleMessages = + let Message (name, format) = DeclareResourceString(name, format) + + do FSComp.SR.RunStartupValidation() + let SeeAlsoE () = Message("SeeAlso", "%s") + let ConstraintSolverTupleDiffLengthsE () = Message("ConstraintSolverTupleDiffLengths", "%d%d") + let ConstraintSolverInfiniteTypesE () = Message("ConstraintSolverInfiniteTypes", "%s%s") + let ConstraintSolverMissingConstraintE () = Message("ConstraintSolverMissingConstraint", "%s") + let ConstraintSolverTypesNotInEqualityRelation1E () = Message("ConstraintSolverTypesNotInEqualityRelation1", "%s%s") + let ConstraintSolverTypesNotInEqualityRelation2E () = Message("ConstraintSolverTypesNotInEqualityRelation2", "%s%s") + let ConstraintSolverTypesNotInSubsumptionRelationE () = Message("ConstraintSolverTypesNotInSubsumptionRelation", "%s%s%s") + let ErrorFromAddingTypeEquation1E () = Message("ErrorFromAddingTypeEquation1", "%s%s%s") + let ErrorFromAddingTypeEquation2E () = Message("ErrorFromAddingTypeEquation2", "%s%s%s") + let ErrorFromApplyingDefault1E () = Message("ErrorFromApplyingDefault1", "%s") + let ErrorFromApplyingDefault2E () = Message("ErrorFromApplyingDefault2", "") + let ErrorsFromAddingSubsumptionConstraintE () = Message("ErrorsFromAddingSubsumptionConstraint", "%s%s%s") + let UpperCaseIdentifierInPatternE () = Message("UpperCaseIdentifierInPattern", "") + let NotUpperCaseConstructorE () = Message("NotUpperCaseConstructor", "") + let NotUpperCaseConstructorWithoutRQAE () = Message("NotUpperCaseConstructorWithoutRQA", "") + let FunctionExpectedE () = Message("FunctionExpected", "") + let BakedInMemberConstraintNameE () = Message("BakedInMemberConstraintName", "%s") + let BadEventTransformationE () = Message("BadEventTransformation", "") + let ParameterlessStructCtorE () = Message("ParameterlessStructCtor", "") + let InterfaceNotRevealedE () = Message("InterfaceNotRevealed", "%s") + let TyconBadArgsE () = Message("TyconBadArgs", "%s%d%d") + let IndeterminateTypeE () = Message("IndeterminateType", "") + let NameClash1E () = Message("NameClash1", "%s%s") + let NameClash2E () = Message("NameClash2", "%s%s%s%s%s") + let Duplicate1E () = Message("Duplicate1", "%s") + let Duplicate2E () = Message("Duplicate2", "%s%s") + let UndefinedName2E () = Message("UndefinedName2", "") + let FieldNotMutableE () = Message("FieldNotMutable", "") + let FieldsFromDifferentTypesE () = Message("FieldsFromDifferentTypes", "%s%s") + let VarBoundTwiceE () = Message("VarBoundTwice", "%s") + let RecursionE () = Message("Recursion", "%s%s%s%s") + let InvalidRuntimeCoercionE () = Message("InvalidRuntimeCoercion", "%s%s%s") + let IndeterminateRuntimeCoercionE () = Message("IndeterminateRuntimeCoercion", "%s%s") + let IndeterminateStaticCoercionE () = Message("IndeterminateStaticCoercion", "%s%s") + let StaticCoercionShouldUseBoxE () = Message("StaticCoercionShouldUseBox", "%s%s") + let TypeIsImplicitlyAbstractE () = Message("TypeIsImplicitlyAbstract", "") + let NonRigidTypar1E () = Message("NonRigidTypar1", "%s%s") + let NonRigidTypar2E () = Message("NonRigidTypar2", "%s%s") + let NonRigidTypar3E () = Message("NonRigidTypar3", "%s%s") + let OBlockEndSentenceE () = Message("BlockEndSentence", "") + let UnexpectedEndOfInputE () = Message("UnexpectedEndOfInput", "") + let UnexpectedE () = Message("Unexpected", "%s") + let NONTERM_interactionE () = Message("NONTERM.interaction", "") + let NONTERM_hashDirectiveE () = Message("NONTERM.hashDirective", "") + let NONTERM_fieldDeclE () = Message("NONTERM.fieldDecl", "") + let NONTERM_unionCaseReprE () = Message("NONTERM.unionCaseRepr", "") + let NONTERM_localBindingE () = Message("NONTERM.localBinding", "") + let NONTERM_hardwhiteLetBindingsE () = Message("NONTERM.hardwhiteLetBindings", "") + let NONTERM_classDefnMemberE () = Message("NONTERM.classDefnMember", "") + let NONTERM_defnBindingsE () = Message("NONTERM.defnBindings", "") + let NONTERM_classMemberSpfnE () = Message("NONTERM.classMemberSpfn", "") + let NONTERM_valSpfnE () = Message("NONTERM.valSpfn", "") + let NONTERM_tyconSpfnE () = Message("NONTERM.tyconSpfn", "") + let NONTERM_anonLambdaExprE () = Message("NONTERM.anonLambdaExpr", "") + let NONTERM_attrUnionCaseDeclE () = Message("NONTERM.attrUnionCaseDecl", "") + let NONTERM_cPrototypeE () = Message("NONTERM.cPrototype", "") + let NONTERM_objectImplementationMembersE () = Message("NONTERM.objectImplementationMembers", "") + let NONTERM_ifExprCasesE () = Message("NONTERM.ifExprCases", "") + let NONTERM_openDeclE () = Message("NONTERM.openDecl", "") + let NONTERM_fileModuleSpecE () = Message("NONTERM.fileModuleSpec", "") + let NONTERM_patternClausesE () = Message("NONTERM.patternClauses", "") + let NONTERM_beginEndExprE () = Message("NONTERM.beginEndExpr", "") + let NONTERM_recdExprE () = Message("NONTERM.recdExpr", "") + let NONTERM_tyconDefnE () = Message("NONTERM.tyconDefn", "") + let NONTERM_exconCoreE () = Message("NONTERM.exconCore", "") + let NONTERM_typeNameInfoE () = Message("NONTERM.typeNameInfo", "") + let NONTERM_attributeListE () = Message("NONTERM.attributeList", "") + let NONTERM_quoteExprE () = Message("NONTERM.quoteExpr", "") + let NONTERM_typeConstraintE () = Message("NONTERM.typeConstraint", "") + let NONTERM_Category_ImplementationFileE () = Message("NONTERM.Category.ImplementationFile", "") + let NONTERM_Category_DefinitionE () = Message("NONTERM.Category.Definition", "") + let NONTERM_Category_SignatureFileE () = Message("NONTERM.Category.SignatureFile", "") + let NONTERM_Category_PatternE () = Message("NONTERM.Category.Pattern", "") + let NONTERM_Category_ExprE () = Message("NONTERM.Category.Expr", "") + let NONTERM_Category_TypeE () = Message("NONTERM.Category.Type", "") + let NONTERM_typeArgsActualE () = Message("NONTERM.typeArgsActual", "") + let TokenName1E () = Message("TokenName1", "%s") + let TokenName1TokenName2E () = Message("TokenName1TokenName2", "%s%s") + let TokenName1TokenName2TokenName3E () = Message("TokenName1TokenName2TokenName3", "%s%s%s") + let RuntimeCoercionSourceSealed1E () = Message("RuntimeCoercionSourceSealed1", "%s") + let RuntimeCoercionSourceSealed2E () = Message("RuntimeCoercionSourceSealed2", "%s") + let CoercionTargetSealedE () = Message("CoercionTargetSealed", "%s") + let UpcastUnnecessaryE () = Message("UpcastUnnecessary", "") + let TypeTestUnnecessaryE () = Message("TypeTestUnnecessary", "") + let OverrideDoesntOverride1E () = Message("OverrideDoesntOverride1", "%s") + let OverrideDoesntOverride2E () = Message("OverrideDoesntOverride2", "%s") + let OverrideDoesntOverride3E () = Message("OverrideDoesntOverride3", "%s") + let OverrideDoesntOverride4E () = Message("OverrideDoesntOverride4", "%s") + let UnionCaseWrongArgumentsE () = Message("UnionCaseWrongArguments", "%d%d") + let UnionPatternsBindDifferentNamesE () = Message("UnionPatternsBindDifferentNames", "") + let RequiredButNotSpecifiedE () = Message("RequiredButNotSpecified", "%s%s%s") + let UseOfAddressOfOperatorE () = Message("UseOfAddressOfOperator", "") + let DefensiveCopyWarningE () = Message("DefensiveCopyWarning", "%s") + let DeprecatedThreadStaticBindingWarningE () = Message("DeprecatedThreadStaticBindingWarning", "") + let FunctionValueUnexpectedE () = Message("FunctionValueUnexpected", "%s") + let UnitTypeExpectedE () = Message("UnitTypeExpected", "%s") + let UnitTypeExpectedWithEqualityE () = Message("UnitTypeExpectedWithEquality", "%s") + let UnitTypeExpectedWithPossiblePropertySetterE () = Message("UnitTypeExpectedWithPossiblePropertySetter", "%s%s%s") + let UnitTypeExpectedWithPossibleAssignmentE () = Message("UnitTypeExpectedWithPossibleAssignment", "%s%s") + let UnitTypeExpectedWithPossibleAssignmentToMutableE () = Message("UnitTypeExpectedWithPossibleAssignmentToMutable", "%s%s") + let RecursiveUseCheckedAtRuntimeE () = Message("RecursiveUseCheckedAtRuntime", "") + let LetRecUnsound1E () = Message("LetRecUnsound1", "%s") + let LetRecUnsound2E () = Message("LetRecUnsound2", "%s%s") + let LetRecUnsoundInnerE () = Message("LetRecUnsoundInner", "%s") + let LetRecEvaluatedOutOfOrderE () = Message("LetRecEvaluatedOutOfOrder", "") + let LetRecCheckedAtRuntimeE () = Message("LetRecCheckedAtRuntime", "") + let SelfRefObjCtor1E () = Message("SelfRefObjCtor1", "") + let SelfRefObjCtor2E () = Message("SelfRefObjCtor2", "") + let VirtualAugmentationOnNullValuedTypeE () = Message("VirtualAugmentationOnNullValuedType", "") + let NonVirtualAugmentationOnNullValuedTypeE () = Message("NonVirtualAugmentationOnNullValuedType", "") + let NonUniqueInferredAbstractSlot1E () = Message("NonUniqueInferredAbstractSlot1", "%s") + let NonUniqueInferredAbstractSlot2E () = Message("NonUniqueInferredAbstractSlot2", "") + let NonUniqueInferredAbstractSlot3E () = Message("NonUniqueInferredAbstractSlot3", "%s%s") + let NonUniqueInferredAbstractSlot4E () = Message("NonUniqueInferredAbstractSlot4", "") + let Failure3E () = Message("Failure3", "%s") + let Failure4E () = Message("Failure4", "%s") + let MatchIncomplete1E () = Message("MatchIncomplete1", "") + let MatchIncomplete2E () = Message("MatchIncomplete2", "%s") + let MatchIncomplete3E () = Message("MatchIncomplete3", "%s") + let MatchIncomplete4E () = Message("MatchIncomplete4", "") + let RuleNeverMatchedE () = Message("RuleNeverMatched", "") + let EnumMatchIncomplete1E () = Message("EnumMatchIncomplete1", "") + let ValNotMutableE () = Message("ValNotMutable", "%s") + let ValNotLocalE () = Message("ValNotLocal", "") + let Obsolete1E () = Message("Obsolete1", "") + let Obsolete2E () = Message("Obsolete2", "%s") + let ExperimentalE () = Message("Experimental", "%s") + let PossibleUnverifiableCodeE () = Message("PossibleUnverifiableCode", "") + let DeprecatedE () = Message("Deprecated", "%s") + let LibraryUseOnlyE () = Message("LibraryUseOnly", "") + let MissingFieldsE () = Message("MissingFields", "%s") + let ValueRestriction1E () = Message("ValueRestriction1", "%s%s%s") + let ValueRestriction2E () = Message("ValueRestriction2", "%s%s%s") + let ValueRestriction3E () = Message("ValueRestriction3", "%s") + let ValueRestriction4E () = Message("ValueRestriction4", "%s%s%s") + let ValueRestriction5E () = Message("ValueRestriction5", "%s%s%s") + let RecoverableParseErrorE () = Message("RecoverableParseError", "") + let ReservedKeywordE () = Message("ReservedKeyword", "%s") + let IndentationProblemE () = Message("IndentationProblem", "%s") + let OverrideInIntrinsicAugmentationE () = Message("OverrideInIntrinsicAugmentation", "") + let OverrideInExtrinsicAugmentationE () = Message("OverrideInExtrinsicAugmentation", "") + let IntfImplInIntrinsicAugmentationE () = Message("IntfImplInIntrinsicAugmentation", "") + let IntfImplInExtrinsicAugmentationE () = Message("IntfImplInExtrinsicAugmentation", "") + let UnresolvedReferenceNoRangeE () = Message("UnresolvedReferenceNoRange", "%s") + let UnresolvedPathReferenceNoRangeE () = Message("UnresolvedPathReferenceNoRange", "%s%s") + let HashIncludeNotAllowedInNonScriptE () = Message("HashIncludeNotAllowedInNonScript", "") + let HashReferenceNotAllowedInNonScriptE () = Message("HashReferenceNotAllowedInNonScript", "") + let HashDirectiveNotAllowedInNonScriptE () = Message("HashDirectiveNotAllowedInNonScript", "") + let FileNameNotResolvedE () = Message("FileNameNotResolved", "%s%s") + let AssemblyNotResolvedE () = Message("AssemblyNotResolved", "%s") + let HashLoadedSourceHasIssues0E () = Message("HashLoadedSourceHasIssues0", "") + let HashLoadedSourceHasIssues1E () = Message("HashLoadedSourceHasIssues1", "") + let HashLoadedSourceHasIssues2E () = Message("HashLoadedSourceHasIssues2", "") + let HashLoadedScriptConsideredSourceE () = Message("HashLoadedScriptConsideredSource", "") + let InvalidInternalsVisibleToAssemblyName1E () = Message("InvalidInternalsVisibleToAssemblyName1", "%s%s") + let InvalidInternalsVisibleToAssemblyName2E () = Message("InvalidInternalsVisibleToAssemblyName2", "%s") + let LoadedSourceNotFoundIgnoringE () = Message("LoadedSourceNotFoundIgnoring", "%s") + let MSBuildReferenceResolutionErrorE () = Message("MSBuildReferenceResolutionError", "%s%s") + let TargetInvocationExceptionWrapperE () = Message("TargetInvocationExceptionWrapper", "%s") + + let getErrorString key = SR.GetString key #if DEBUG let mutable showParserStackOnParseError = false #endif -let getErrorString key = SR.GetString key - let (|InvalidArgument|_|) (exn: exn) = match exn with | :? ArgumentException as e -> Some e.Message | _ -> None -let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSuggestNames: bool) = - - let suggestNames suggestionsF idText = - if canSuggestNames then - let buffer = DiagnosticResolutionHints.SuggestionBuffer idText +let OutputNameSuggestions (os: StringBuilder) canSuggestNames suggestionsF idText = + if canSuggestNames then + let buffer = DiagnosticResolutionHints.SuggestionBuffer idText - if not buffer.Disabled then - suggestionsF buffer.Add + if not buffer.Disabled then + suggestionsF buffer.Add - if not buffer.IsEmpty then - os.AppendString " " - os.AppendString(FSComp.SR.undefinedNameSuggestionsIntro ()) + if not buffer.IsEmpty then + os.AppendString " " + os.AppendString(FSComp.SR.undefinedNameSuggestionsIntro ()) - for value in buffer do - os.AppendLine() |> ignore - os.AppendString " " - os.AppendString(ConvertValLogicalNameToDisplayNameCore value) + for value in buffer do + os.AppendLine() |> ignore + os.AppendString " " + os.AppendString(ConvertValLogicalNameToDisplayNameCore value) - let rec OutputExceptionR (os: StringBuilder) error = +type Exception with + member exn.Output (os: StringBuilder, canSuggestNames) = - match error with + match exn with | ConstraintSolverTupleDiffLengths (_, tl1, tl2, m, m2) -> os.AppendString(ConstraintSolverTupleDiffLengthsE().Format tl1.Length tl2.Length) @@ -691,15 +737,13 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu | ContextInfo.NoContext -> false | _ -> true) -> - OutputExceptionR os e + e.Output (os, canSuggestNames) + + | ErrorFromAddingTypeEquation (error = ConstraintSolverTypesNotInSubsumptionRelation _ as e) -> + e.Output (os, canSuggestNames) - | ErrorFromAddingTypeEquation (_, - _, - _, - _, - (ConstraintSolverTypesNotInSubsumptionRelation _ - | ConstraintSolverError _ as e), - _) -> OutputExceptionR os e + | ErrorFromAddingTypeEquation (error = ConstraintSolverError _ as e) -> + e.Output (os, canSuggestNames) | ErrorFromAddingTypeEquation (g, denv, ty1, ty2, e, _) -> if not (typeEquiv g ty1 ty2) then @@ -708,12 +752,12 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu if ty1 <> ty2 + tpcs then os.AppendString(ErrorFromAddingTypeEquation2E().Format ty1 ty2 tpcs) - OutputExceptionR os e + e.Output (os, canSuggestNames) | ErrorFromApplyingDefault (_, denv, _, defaultType, e, _) -> let defaultType = NicePrint.minimalStringOfType denv defaultType os.AppendString(ErrorFromApplyingDefault1E().Format defaultType) - OutputExceptionR os e + e.Output (os, canSuggestNames) os.AppendString(ErrorFromApplyingDefault2E().Format) | ErrorsFromAddingSubsumptionConstraint (g, denv, ty1, ty2, e, contextInfo, _) -> @@ -732,9 +776,9 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu if ty1 <> (ty2 + tpcs) then os.AppendString(ErrorsFromAddingSubsumptionConstraintE().Format ty2 ty1 tpcs) else - OutputExceptionR os e + e.Output (os, canSuggestNames) else - OutputExceptionR os e + e.Output (os, canSuggestNames) | UpperCaseIdentifierInPattern _ -> os.AppendString(UpperCaseIdentifierInPatternE().Format) @@ -742,12 +786,12 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu | NotUpperCaseConstructorWithoutRQA _ -> os.AppendString(NotUpperCaseConstructorWithoutRQAE().Format) - | ErrorFromAddingConstraint (_, e, _) -> OutputExceptionR os e + | ErrorFromAddingConstraint (_, e, _) -> e.Output (os, canSuggestNames) #if !NO_TYPEPROVIDERS | TypeProviders.ProvidedTypeResolutionNoRange e - | TypeProviders.ProvidedTypeResolution (_, e) -> OutputExceptionR os e + | TypeProviders.ProvidedTypeResolution (_, e) -> e.Output (os, canSuggestNames) | :? TypeProviderError as e -> os.AppendString(e.ContextualErrorMessage) #endif @@ -910,7 +954,7 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu | UndefinedName (_, k, id, suggestionsF) -> os.AppendString(k (ConvertValLogicalNameToDisplayNameCore id.idText)) - suggestNames suggestionsF id.idText + OutputNameSuggestions os canSuggestNames suggestionsF id.idText | InternalUndefinedItemRef (f, smr, ccuName, s) -> let _, errs = f (smr, ccuName, s) @@ -1616,12 +1660,10 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu | DiagnosticWithSuggestions (_, s, _, idText, suggestionF) -> os.AppendString(ConvertValLogicalNameToDisplayNameCore s) - suggestNames suggestionF idText + OutputNameSuggestions os canSuggestNames suggestionF idText | InternalError (s, _) - | InvalidArgument s - | Failure s as exn -> ignore exn // use the argument, even in non DEBUG let f1 = SR.GetString("Failure1") @@ -1636,7 +1678,8 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu Debug.Assert(false, sprintf "Unexpected exception seen in compiler: %s\n%s" s (exn.ToString())) #endif - | WrappedError (exn, _) -> OutputExceptionR os exn + | WrappedError (e, _) -> + e.Output (os, canSuggestNames) | PatternMatchCompilation.MatchIncomplete (isComp, cexOpt, _) -> os.AppendString(MatchIncomplete1E().Format) @@ -1791,17 +1834,17 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu os.AppendString(FSComp.SR.buildUnexpectedFileNameCharacter (fileName, string invalidChar) |> snd) | HashLoadedSourceHasIssues (infos, warnings, errors, _) -> - let Emit (l: exn list) = OutputExceptionR os (List.head l) - if isNil warnings && isNil errors then - os.AppendString(HashLoadedSourceHasIssues0E().Format) - Emit infos - elif isNil errors then - os.AppendString(HashLoadedSourceHasIssues1E().Format) - Emit warnings - else + match warnings, errors with + | _, e::_ -> os.AppendString(HashLoadedSourceHasIssues2E().Format) - Emit errors + e.Output (os, canSuggestNames) + | e::_, _ -> + os.AppendString(HashLoadedSourceHasIssues1E().Format) + e.Output (os, canSuggestNames) + | [], [] -> + os.AppendString(HashLoadedSourceHasIssues0E().Format) + infos.Head.Output (os, canSuggestNames) | HashLoadedScriptConsideredSource _ -> os.AppendString(HashLoadedScriptConsideredSourceE().Format) @@ -1817,7 +1860,8 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu | MSBuildReferenceResolutionError (code, message, _) -> os.AppendString(MSBuildReferenceResolutionErrorE().Format message code) // Strip TargetInvocationException wrappers - | :? System.Reflection.TargetInvocationException as exn -> OutputExceptionR os exn.InnerException + | :? TargetInvocationException as exn -> + exn.InnerException.Output (os, canSuggestNames) | :? FileNotFoundException as exn -> Printf.bprintf os "%s" exn.Message @@ -1840,36 +1884,35 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu Debug.Assert(false, sprintf "Unknown exception seen in compiler: %s" (exn.ToString())) #endif - OutputExceptionR os diagnostic.Exception +/// Eagerly format a PhasedDiagnostic to a DiagnosticWithText +type PhasedDiagnostic with -// remove any newlines and tabs -let OutputPhasedDiagnostic (os: StringBuilder) (diagnostic: PhasedDiagnostic) (flattenErrors: bool) (suggestNames: bool) = - let buf = StringBuilder() + // remove any newlines and tabs + member x.OutputCore (os: StringBuilder, flattenErrors: bool, suggestNames: bool) = + let buf = StringBuilder() - OutputPhasedErrorR buf diagnostic suggestNames + x.Exception.Output(buf, suggestNames) - let text = - if flattenErrors then - NormalizeErrorString(buf.ToString()) - else - buf.ToString() + let text = + if flattenErrors then + NormalizeErrorString(buf.ToString()) + else + buf.ToString() - os.AppendString text + os.AppendString text -/// Eagerly format a PhasedDiagnostic to a DiagnosticWithText -let EagerlyFormatDiagnostic (flattenErrors: bool) (suggestNames: bool) (diagnostic: PhasedDiagnostic) = - match GetRangeOfDiagnostic diagnostic with - | Some m -> + member x.FormatCore (flattenErrors: bool, suggestNames: bool) = let os = StringBuilder() + x.OutputCore(os, flattenErrors, suggestNames) + os.ToString() - OutputPhasedDiagnostic os diagnostic flattenErrors suggestNames - - let message = os.ToString() - - DiagnosticWithText(GetDiagnosticNumber diagnostic, message, m) - |> ToPhased diagnostic.Phase - - | None -> diagnostic + member x.EagerlyFormatCore (flattenErrors: bool, suggestNames: bool) = + match x.Range with + | Some m -> + let message = x.FormatCore (flattenErrors, suggestNames) + let exn = DiagnosticWithText(x.Number, message, m) + { Exception = exn; Phase = x.Phase } + | None -> x let SanitizeFileName fileName implicitIncludeDir = // The assert below is almost ok, but it fires in two cases: @@ -1920,6 +1963,77 @@ type FormattedDiagnostic = | Short of FSharpDiagnosticSeverity * string | Long of FSharpDiagnosticSeverity * FormattedDiagnosticDetailedInfo +let FormatDiagnosticLocation (implicitIncludeDir, showFullPaths, diagnosticStyle) m : FormattedDiagnosticLocation = + if equals m rangeStartup || equals m rangeCmdArgs then + { + Range = m + TextRepresentation = "" + IsEmpty = true + File = "" + } + else + let file = m.FileName + + let file = + if showFullPaths then + FileSystem.GetFullFilePathInDirectoryShim implicitIncludeDir file + else + SanitizeFileName file implicitIncludeDir + + let text, m, file = + match diagnosticStyle with + | DiagnosticStyle.Emacs -> + let file = file.Replace("\\", "/") + (sprintf "File \"%s\", line %d, characters %d-%d: " file m.StartLine m.StartColumn m.EndColumn), m, file + + // We're adjusting the columns here to be 1-based - both for parity with C# and for MSBuild, which assumes 1-based columns for error output + | DiagnosticStyle.Default -> + let file = file.Replace('/', Path.DirectorySeparatorChar) + let m = mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) m.End + (sprintf "%s(%d,%d): " file m.StartLine m.StartColumn), m, file + + // We may also want to change Test to be 1-based + | DiagnosticStyle.Test -> + let file = file.Replace("/", "\\") + + let m = + mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1)) + + sprintf "%s(%d,%d-%d,%d): " file m.StartLine m.StartColumn m.EndLine m.EndColumn, m, file + + | DiagnosticStyle.Gcc -> + let file = file.Replace('/', Path.DirectorySeparatorChar) + + let m = + mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1)) + + sprintf "%s:%d:%d: " file m.StartLine m.StartColumn, m, file + + // Here, we want the complete range information so Project Systems can generate proper squiggles + | DiagnosticStyle.VisualStudio -> + // Show prefix only for real files. Otherwise, we just want a truncated error like: + // parse error FS0031: blah blah + if + not (equals m range0) + && not (equals m rangeStartup) + && not (equals m rangeCmdArgs) + then + let file = file.Replace("/", "\\") + + let m = + mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1)) + + sprintf "%s(%d,%d,%d,%d): " file m.StartLine m.StartColumn m.EndLine m.EndColumn, m, file + else + "", m, file + + { + Range = m + TextRepresentation = text + IsEmpty = false + File = file + } + /// returns sequence that contains Diagnostic for the given error + Diagnostic for all related errors let CollectFormattedDiagnostics ( @@ -1931,76 +2045,6 @@ let CollectFormattedDiagnostics diagnostic: PhasedDiagnostic, suggestNames: bool ) = - let outputWhere (showFullPaths, diagnosticStyle) m : FormattedDiagnosticLocation = - if equals m rangeStartup || equals m rangeCmdArgs then - { - Range = m - TextRepresentation = "" - IsEmpty = true - File = "" - } - else - let file = m.FileName - - let file = - if showFullPaths then - FileSystem.GetFullFilePathInDirectoryShim implicitIncludeDir file - else - SanitizeFileName file implicitIncludeDir - - let text, m, file = - match diagnosticStyle with - | DiagnosticStyle.Emacs -> - let file = file.Replace("\\", "/") - (sprintf "File \"%s\", line %d, characters %d-%d: " file m.StartLine m.StartColumn m.EndColumn), m, file - - // We're adjusting the columns here to be 1-based - both for parity with C# and for MSBuild, which assumes 1-based columns for error output - | DiagnosticStyle.Default -> - let file = file.Replace('/', Path.DirectorySeparatorChar) - let m = mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) m.End - (sprintf "%s(%d,%d): " file m.StartLine m.StartColumn), m, file - - // We may also want to change Test to be 1-based - | DiagnosticStyle.Test -> - let file = file.Replace("/", "\\") - - let m = - mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1)) - - sprintf "%s(%d,%d-%d,%d): " file m.StartLine m.StartColumn m.EndLine m.EndColumn, m, file - - | DiagnosticStyle.Gcc -> - let file = file.Replace('/', Path.DirectorySeparatorChar) - - let m = - mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1)) - - sprintf "%s:%d:%d: " file m.StartLine m.StartColumn, m, file - - // Here, we want the complete range information so Project Systems can generate proper squiggles - | DiagnosticStyle.VisualStudio -> - // Show prefix only for real files. Otherwise, we just want a truncated error like: - // parse error FS0031: blah blah - if - not (equals m range0) - && not (equals m rangeStartup) - && not (equals m rangeCmdArgs) - then - let file = file.Replace("/", "\\") - - let m = - mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1)) - - sprintf "%s(%d,%d,%d,%d): " file m.StartLine m.StartColumn m.EndLine m.EndColumn, m, file - else - "", m, file - - { - Range = m - TextRepresentation = text - IsEmpty = false - File = file - } match diagnostic.Exception with | ReportedError _ -> @@ -2012,41 +2056,37 @@ let CollectFormattedDiagnostics | _ -> let errors = ResizeArray() - let report diagnostic = - let OutputCanonicalInformation (subcategory, errorNumber) : FormattedDiagnosticCanonicalInformation = - let message = - match severity with - | FSharpDiagnosticSeverity.Error -> "error" - | FSharpDiagnosticSeverity.Warning -> "warning" - | FSharpDiagnosticSeverity.Info - | FSharpDiagnosticSeverity.Hidden -> "info" - - let text = - match diagnosticStyle with - // Show the subcategory for --vserrors so that we can fish it out in Visual Studio and use it to determine error stickiness. - | DiagnosticStyle.VisualStudio -> sprintf "%s %s FS%04d: " subcategory message errorNumber - | _ -> sprintf "%s FS%04d: " message errorNumber + let report (diagnostic: PhasedDiagnostic) = + let where = + match diagnostic.Range with + | Some m -> + FormatDiagnosticLocation (implicitIncludeDir, showFullPaths, diagnosticStyle) m + |> Some + | None -> None + + let subcategory = diagnostic.Subcategory() + let errorNumber = diagnostic.Number + let message = + match severity with + | FSharpDiagnosticSeverity.Error -> "error" + | FSharpDiagnosticSeverity.Warning -> "warning" + | FSharpDiagnosticSeverity.Info + | FSharpDiagnosticSeverity.Hidden -> "info" + + let text = + match diagnosticStyle with + // Show the subcategory for --vserrors so that we can fish it out in Visual Studio and use it to determine error stickiness. + | DiagnosticStyle.VisualStudio -> sprintf "%s %s FS%04d: " subcategory message errorNumber + | _ -> sprintf "%s FS%04d: " message errorNumber + let canonical : FormattedDiagnosticCanonicalInformation = { ErrorNumber = errorNumber Subcategory = subcategory TextRepresentation = text } - let diag = StripRelatedDiagnostics diagnostic - - let where = - match GetRangeOfDiagnostic diag with - | Some m -> Some(outputWhere (showFullPaths, diagnosticStyle) m) - | None -> None - - let canonical = - OutputCanonicalInformation(diagnostic.Subcategory(), GetDiagnosticNumber diag) - - let message = - let os = StringBuilder() - OutputPhasedDiagnostic os diag flattenErrors suggestNames - os.ToString() + let message = diagnostic.FormatCore (flattenErrors, suggestNames) let entry: FormattedDiagnosticDetailedInfo = { @@ -2057,16 +2097,12 @@ let CollectFormattedDiagnostics errors.Add(FormattedDiagnostic.Long(severity, entry)) - match diagnostic with + match diagnostic.Exception with #if !NO_TYPEPROVIDERS - | { - Exception = :? TypeProviderError as tpe - } -> - tpe.Iter(fun exn -> - let newErr = { diagnostic with Exception = exn } - report newErr) + | :? TypeProviderError as tpe -> + tpe.Iter(fun exn -> report { diagnostic with Exception = exn }) #endif - | x -> report x + | _ -> report diagnostic errors.ToArray() @@ -2091,8 +2127,8 @@ let OutputDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, diagnost os.AppendString details.Canonical.TextRepresentation os.AppendString details.Message -let OutputDiagnosticContext prefix fileLineFunction os diagnostic = - match GetRangeOfDiagnostic diagnostic with +let OutputDiagnosticContext prefix fileLineFunction os (diagnostic: PhasedDiagnostic) = + match diagnostic.Range with | None -> () | Some m -> let fileName = m.FileName @@ -2107,48 +2143,6 @@ let OutputDiagnosticContext prefix fileLineFunction os diagnostic = Printf.bprintf os "%s%s\n" prefix line Printf.bprintf os "%s%s%s\n" prefix (String.make iA '-') (String.make iLen '^') -let ReportDiagnosticAsInfo options (diagnostic, severity) = - match severity with - | FSharpDiagnosticSeverity.Error -> false - | FSharpDiagnosticSeverity.Warning -> false - | FSharpDiagnosticSeverity.Info -> - let n = GetDiagnosticNumber diagnostic - - IsWarningOrInfoEnabled (diagnostic, severity) n options.WarnLevel options.WarnOn - && not (List.contains n options.WarnOff) - | FSharpDiagnosticSeverity.Hidden -> false - -let ReportDiagnosticAsWarning options (diagnostic, severity) = - match severity with - | FSharpDiagnosticSeverity.Error -> false - | FSharpDiagnosticSeverity.Warning -> - let n = GetDiagnosticNumber diagnostic - - IsWarningOrInfoEnabled (diagnostic, severity) n options.WarnLevel options.WarnOn - && not (List.contains n options.WarnOff) - // Informational become warning if explicitly on and not explicitly off - | FSharpDiagnosticSeverity.Info -> - let n = GetDiagnosticNumber diagnostic - List.contains n options.WarnOn && not (List.contains n options.WarnOff) - | FSharpDiagnosticSeverity.Hidden -> false - -let ReportDiagnosticAsError options (diagnostic, severity) = - match severity with - | FSharpDiagnosticSeverity.Error -> true - // Warnings become errors in some situations - | FSharpDiagnosticSeverity.Warning -> - let n = GetDiagnosticNumber diagnostic - - IsWarningOrInfoEnabled (diagnostic, severity) n options.WarnLevel options.WarnOn - && not (List.contains n options.WarnAsWarn) - && ((options.GlobalWarnAsError && not (List.contains n options.WarnOff)) - || List.contains n options.WarnAsError) - // Informational become errors if explicitly WarnAsError - | FSharpDiagnosticSeverity.Info -> - let n = GetDiagnosticNumber diagnostic - List.contains n options.WarnAsError - | FSharpDiagnosticSeverity.Hidden -> false - //---------------------------------------------------------------------------- // Scoped #nowarn pragmas @@ -2169,14 +2163,14 @@ type DiagnosticsLoggerFilteringByScopedPragmas ) = inherit DiagnosticsLogger("DiagnosticsLoggerFilteringByScopedPragmas") - override _.DiagnosticSink(diagnostic, severity) = + override _.DiagnosticSink(diagnostic: PhasedDiagnostic, severity) = if severity = FSharpDiagnosticSeverity.Error then diagnosticsLogger.DiagnosticSink(diagnostic, severity) else let report = - let warningNum = GetDiagnosticNumber diagnostic + let warningNum = diagnostic.Number - match GetRangeOfDiagnostic diagnostic with + match diagnostic.Range with | Some m -> scopedPragmas |> List.exists (fun pragma -> @@ -2189,11 +2183,11 @@ type DiagnosticsLoggerFilteringByScopedPragmas | None -> true if report then - if ReportDiagnosticAsError diagnosticOptions (diagnostic, severity) then + if diagnostic.ReportAsError (diagnosticOptions, severity) then diagnosticsLogger.DiagnosticSink(diagnostic, FSharpDiagnosticSeverity.Error) - elif ReportDiagnosticAsWarning diagnosticOptions (diagnostic, severity) then + elif diagnostic.ReportAsWarning (diagnosticOptions, severity) then diagnosticsLogger.DiagnosticSink(diagnostic, FSharpDiagnosticSeverity.Warning) - elif ReportDiagnosticAsInfo diagnosticOptions (diagnostic, severity) then + elif diagnostic.ReportAsInfo (diagnosticOptions, severity) then diagnosticsLogger.DiagnosticSink(diagnostic, severity) override _.ErrorCount = diagnosticsLogger.ErrorCount diff --git a/src/Compiler/Driver/CompilerDiagnostics.fsi b/src/Compiler/Driver/CompilerDiagnostics.fsi index bbfb0d27fea..579e24079c7 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fsi +++ b/src/Compiler/Driver/CompilerDiagnostics.fsi @@ -47,19 +47,28 @@ exception DeprecatedCommandLineOptionNoDescription of string * range /// This exception is an old-style way of reporting a diagnostic exception InternalCommandLineOption of string * range -/// Get the location associated with an error -val GetRangeOfDiagnostic: diagnostic: PhasedDiagnostic -> range option +type PhasedDiagnostic with -/// Get the number associated with an error -val GetDiagnosticNumber: diagnostic: PhasedDiagnostic -> int + /// Get the location associated with a diagnostic + member Range: range option -/// Eagerly format a PhasedDiagnostic to a DiagnosticWithText -val EagerlyFormatDiagnostic: - flattenErrors: bool -> suggestNames: bool -> diagnostic: PhasedDiagnostic -> PhasedDiagnostic + /// Get the number associated with a diagnostic + member Number: int -/// Output an error to a buffer -val OutputPhasedDiagnostic: - os: StringBuilder -> diagnostic: PhasedDiagnostic -> flattenErrors: bool -> suggestNames: bool -> unit + /// Eagerly format a PhasedDiagnostic return as a new PhasedDiagnostic requiring no formatting of types. + member EagerlyFormatCore: flattenErrors: bool * suggestNames: bool -> PhasedDiagnostic + + /// Format the core of the diagnostic as a string. Doesn't include the range information. + member FormatCore: flattenErrors: bool * suggestNames: bool -> string + + /// Indicates if we should report a diagnostic as a warning + member ReportAsInfo: FSharpDiagnosticOptions * FSharpDiagnosticSeverity -> bool + + /// Indicates if we should report a diagnostic as a warning + member ReportAsWarning: FSharpDiagnosticOptions * FSharpDiagnosticSeverity -> bool + + /// Indicates if we should report a warning as an error + member ReportAsError: FSharpDiagnosticOptions * FSharpDiagnosticSeverity -> bool /// Output an error or warning to a buffer val OutputDiagnostic: @@ -86,15 +95,6 @@ val GetDiagnosticsLoggerFilteringByScopedPragmas: val SanitizeFileName: fileName: string -> implicitIncludeDir: string -> string -/// Indicates if we should report a diagnostic as a warning -val ReportDiagnosticAsInfo: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool - -/// Indicates if we should report a diagnostic as a warning -val ReportDiagnosticAsWarning: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool - -/// Indicates if we should report a warning as an error -val ReportDiagnosticAsError: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool - /// Used internally and in LegacyHostedCompilerForTesting [] type FormattedDiagnosticLocation = diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 853904eb3fc..83d5577b4e4 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -76,7 +76,7 @@ type DiagnosticsLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, override _.ErrorCount = errors override x.DiagnosticSink(diagnostic, severity) = - if ReportDiagnosticAsError tcConfigB.diagnosticsOptions (diagnostic, severity) then + if diagnostic.ReportAsError (tcConfigB.diagnosticsOptions, severity) then if errors >= tcConfigB.maxErrors then x.HandleTooManyErrors(FSComp.SR.fscTooManyErrors ()) exiter.Exit 1 @@ -92,10 +92,10 @@ type DiagnosticsLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, Debug.Assert(false, sprintf "Lookup exception in compiler: %s" (diagnostic.Exception.ToString())) | _ -> () - elif ReportDiagnosticAsWarning tcConfigB.diagnosticsOptions (diagnostic, severity) then + elif diagnostic.ReportAsWarning (tcConfigB.diagnosticsOptions, severity) then x.HandleIssue(tcConfigB, diagnostic, FSharpDiagnosticSeverity.Warning) - elif ReportDiagnosticAsInfo tcConfigB.diagnosticsOptions (diagnostic, severity) then + elif diagnostic.ReportAsInfo (tcConfigB.diagnosticsOptions, severity) then x.HandleIssue(tcConfigB, diagnostic, severity) /// Create an error logger that counts and prints errors @@ -170,8 +170,8 @@ let TypeCheck let tcInitialState = GetInitialTcState(rangeStartup, ccuName, tcConfig, tcGlobals, tcImports, tcEnv0, openDecls0) - let eagerFormat diag = - EagerlyFormatDiagnostic tcConfig.flatErrors true diag + let eagerFormat (diag: PhasedDiagnostic) = + diag.EagerlyFormatCore (tcConfig.flatErrors, true) CheckClosedInputSet( ctok, diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 084bad942b3..0b0570fddca 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -773,14 +773,14 @@ type internal DiagnosticsLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, member _.ResetErrorCount() = errorCount <- 0 - override x.DiagnosticSink(err, severity) = - if ReportDiagnosticAsError tcConfigB.diagnosticsOptions (err, severity) then + override _.DiagnosticSink(err, severity) = + if err.ReportAsError (tcConfigB.diagnosticsOptions, severity) 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 - elif ReportDiagnosticAsWarning tcConfigB.diagnosticsOptions (err, severity) then + elif err.ReportAsWarning (tcConfigB.diagnosticsOptions, severity) then DoWithDiagnosticColor FSharpDiagnosticSeverity.Warning (fun () -> fsiConsoleOutput.Error.WriteLine() writeViaBuffer fsiConsoleOutput.Error (OutputDiagnosticContext " " fsiStdinSyphon.GetLine) err @@ -788,7 +788,7 @@ type internal DiagnosticsLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.Flush()) - elif ReportDiagnosticAsInfo tcConfigB.diagnosticsOptions (err, severity) then + elif err.ReportAsInfo (tcConfigB.diagnosticsOptions, severity) then DoWithDiagnosticColor FSharpDiagnosticSeverity.Info (fun () -> fsiConsoleOutput.Error.WriteLine() writeViaBuffer fsiConsoleOutput.Error (OutputDiagnosticContext " " fsiStdinSyphon.GetLine) err @@ -797,7 +797,7 @@ type internal DiagnosticsLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.Flush()) - override x.ErrorCount = errorCount + override _.ErrorCount = errorCount type DiagnosticsLogger with @@ -1672,8 +1672,8 @@ type internal FsiDynamicCompiler( let ilxGenerator = istate.ilxGenerator let tcConfig = TcConfig.Create(tcConfigB,validate=false) - let eagerFormat diag = - EagerlyFormatDiagnostic tcConfig.flatErrors true diag + let eagerFormat (diag: PhasedDiagnostic) = + diag.EagerlyFormatCore (tcConfig.flatErrors, true) // Typecheck. The lock stops the type checker running at the same time as the // server intellisense implementation (which is currently incomplete and #if disabled) diff --git a/src/Compiler/Symbols/FSharpDiagnostic.fs b/src/Compiler/Symbols/FSharpDiagnostic.fs index e24fe472b8f..a0c9a47fa88 100644 --- a/src/Compiler/Symbols/FSharpDiagnostic.fs +++ b/src/Compiler/Symbols/FSharpDiagnostic.fs @@ -71,10 +71,10 @@ 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(diagnostic, severity, fallbackRange: range, suggestNames: bool) = - let m = match GetRangeOfDiagnostic diagnostic with Some m -> m | None -> fallbackRange - let msg = buildString (fun buf -> OutputPhasedDiagnostic buf diagnostic false suggestNames) - let errorNum = GetDiagnosticNumber diagnostic + static member CreateFromException(diagnostic: PhasedDiagnostic, severity, fallbackRange: range, suggestNames: bool) = + let m = match diagnostic.Range with Some m -> m | None -> fallbackRange + let msg = diagnostic.FormatCore(false, suggestNames) + let errorNum = diagnostic.Number FSharpDiagnostic(m, severity, msg, diagnostic.Subcategory(), errorNum, "FS") /// Decompose a warning or error into parts: position, severity, message, error number @@ -165,12 +165,12 @@ type internal CompilationDiagnosticLogger (debugName: string, options: FSharpDia let diagnostics = ResizeArray<_>() override _.DiagnosticSink(diagnostic, severity) = - if ReportDiagnosticAsError options (diagnostic, severity) then + if diagnostic.ReportAsError (options, severity) then diagnostics.Add(diagnostic, FSharpDiagnosticSeverity.Error) errorCount <- errorCount + 1 - elif ReportDiagnosticAsWarning options (diagnostic, severity) then + elif diagnostic.ReportAsWarning (options, severity) then diagnostics.Add(diagnostic, FSharpDiagnosticSeverity.Warning) - elif ReportDiagnosticAsInfo options (diagnostic, severity) then + elif diagnostic.ReportAsInfo (options, severity) then diagnostics.Add(diagnostic, severity) override _.ErrorCount = errorCount @@ -179,16 +179,16 @@ type internal CompilationDiagnosticLogger (debugName: string, options: FSharpDia module DiagnosticHelpers = - let ReportDiagnostic (options: FSharpDiagnosticOptions, allErrors, mainInputFileName, fileInfo, diagnostic, severity, suggestNames) = + let ReportDiagnostic (options: FSharpDiagnosticOptions, allErrors, mainInputFileName, fileInfo, diagnostic: PhasedDiagnostic, severity, suggestNames) = [ let severity = - if ReportDiagnosticAsError options (diagnostic, severity) then + if diagnostic.ReportAsError (options, severity) then FSharpDiagnosticSeverity.Error else severity if severity = FSharpDiagnosticSeverity.Error || - ReportDiagnosticAsWarning options (diagnostic, severity) || - ReportDiagnosticAsInfo options (diagnostic, severity) then + diagnostic.ReportAsWarning (options, severity) || + diagnostic.ReportAsInfo (options, severity) then // 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. From f177cf84fe84fc5efc05380716b1b879b603952c Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 24 Aug 2022 14:55:28 +0100 Subject: [PATCH 10/33] further cleanup --- src/Compiler/Driver/CompilerDiagnostics.fs | 93 ++++++++++--------- src/Compiler/Driver/CompilerDiagnostics.fsi | 31 +++---- src/Compiler/Driver/ScriptClosure.fs | 4 +- src/Compiler/Driver/fsc.fs | 43 ++++----- src/Compiler/Driver/fsc.fsi | 2 +- src/Compiler/Interactive/fsi.fs | 22 ++--- .../Legacy/LegacyHostedCompilerForTesting.fs | 9 +- src/Compiler/Service/FSharpCheckerResults.fs | 4 +- src/Compiler/Utilities/lib.fs | 4 +- src/Compiler/Utilities/lib.fsi | 2 +- 10 files changed, 105 insertions(+), 109 deletions(-) diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index 8eaa46f51a6..e58a2ad9f9f 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -1963,7 +1963,7 @@ type FormattedDiagnostic = | Short of FSharpDiagnosticSeverity * string | Long of FSharpDiagnosticSeverity * FormattedDiagnosticDetailedInfo -let FormatDiagnosticLocation (implicitIncludeDir, showFullPaths, diagnosticStyle) m : FormattedDiagnosticLocation = +let FormatDiagnosticLocation (tcConfig: TcConfig) m : FormattedDiagnosticLocation = if equals m rangeStartup || equals m rangeCmdArgs then { Range = m @@ -1975,13 +1975,13 @@ let FormatDiagnosticLocation (implicitIncludeDir, showFullPaths, diagnosticStyle let file = m.FileName let file = - if showFullPaths then - FileSystem.GetFullFilePathInDirectoryShim implicitIncludeDir file + if tcConfig.showFullPaths then + FileSystem.GetFullFilePathInDirectoryShim tcConfig.implicitIncludeDir file else - SanitizeFileName file implicitIncludeDir + SanitizeFileName file tcConfig.implicitIncludeDir let text, m, file = - match diagnosticStyle with + match tcConfig.diagnosticStyle with | DiagnosticStyle.Emacs -> let file = file.Replace("\\", "/") (sprintf "File \"%s\", line %d, characters %d-%d: " file m.StartLine m.StartColumn m.EndColumn), m, file @@ -2037,10 +2037,7 @@ let FormatDiagnosticLocation (implicitIncludeDir, showFullPaths, diagnosticStyle /// returns sequence that contains Diagnostic for the given error + Diagnostic for all related errors let CollectFormattedDiagnostics ( - implicitIncludeDir, - showFullPaths, - flattenErrors, - diagnosticStyle, + tcConfig: TcConfig, severity: FSharpDiagnosticSeverity, diagnostic: PhasedDiagnostic, suggestNames: bool @@ -2060,7 +2057,7 @@ let CollectFormattedDiagnostics let where = match diagnostic.Range with | Some m -> - FormatDiagnosticLocation (implicitIncludeDir, showFullPaths, diagnosticStyle) m + FormatDiagnosticLocation tcConfig m |> Some | None -> None @@ -2074,7 +2071,7 @@ let CollectFormattedDiagnostics | FSharpDiagnosticSeverity.Hidden -> "info" let text = - match diagnosticStyle with + match tcConfig.diagnosticStyle with // Show the subcategory for --vserrors so that we can fish it out in Visual Studio and use it to determine error stickiness. | DiagnosticStyle.VisualStudio -> sprintf "%s %s FS%04d: " subcategory message errorNumber | _ -> sprintf "%s FS%04d: " message errorNumber @@ -2086,7 +2083,7 @@ let CollectFormattedDiagnostics TextRepresentation = text } - let message = diagnostic.FormatCore (flattenErrors, suggestNames) + let message = diagnostic.FormatCore (tcConfig.flatErrors, suggestNames) let entry: FormattedDiagnosticDetailedInfo = { @@ -2106,42 +2103,50 @@ let CollectFormattedDiagnostics errors.ToArray() -/// used by fsc.exe and fsi.exe, but not by VS -/// prints error and related errors to the specified StringBuilder -let OutputDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, diagnosticStyle, severity) os (diagnostic: PhasedDiagnostic) = +type PhasedDiagnostic with - // '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 = - CollectFormattedDiagnostics(implicitIncludeDir, showFullPaths, flattenErrors, diagnosticStyle, severity, diagnostic, true) + /// used by fsc.exe and fsi.exe, but not by VS + /// prints error and related errors to the specified StringBuilder + member diagnostic.Output (buf, tcConfig: TcConfig, severity) = - for e in errors do - Printf.bprintf os "\n" + // '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 diagnostics = + CollectFormattedDiagnostics(tcConfig, severity, diagnostic, true) - match e with - | FormattedDiagnostic.Short (_, txt) -> os.AppendString txt |> ignore - | FormattedDiagnostic.Long (_, details) -> - match details.Location with - | Some l when not l.IsEmpty -> os.AppendString l.TextRepresentation - | _ -> () + for e in diagnostics do + Printf.bprintf buf "\n" + + match e with + | FormattedDiagnostic.Short (_, txt) -> buf.AppendString txt |> ignore + | FormattedDiagnostic.Long (_, details) -> + match details.Location with + | Some l when not l.IsEmpty -> buf.AppendString l.TextRepresentation + | _ -> () + + buf.AppendString details.Canonical.TextRepresentation + buf.AppendString details.Message - os.AppendString details.Canonical.TextRepresentation - os.AppendString details.Message - -let OutputDiagnosticContext prefix fileLineFunction os (diagnostic: PhasedDiagnostic) = - match diagnostic.Range with - | None -> () - | Some m -> - let fileName = m.FileName - let lineA = m.StartLine - let lineB = m.EndLine - let line = fileLineFunction fileName lineA - - if line <> "" then - let iA = m.StartColumn - let iB = m.EndColumn - let iLen = if lineA = lineB then max (iB - iA) 1 else 1 - Printf.bprintf os "%s%s\n" prefix line - Printf.bprintf os "%s%s%s\n" prefix (String.make iA '-') (String.make iLen '^') + member diagnostic.OutputContext (buf, prefix, fileLineFunction) = + match diagnostic.Range with + | None -> () + | Some m -> + let fileName = m.FileName + let lineA = m.StartLine + let lineB = m.EndLine + let line = fileLineFunction fileName lineA + + if line <> "" then + let iA = m.StartColumn + let iB = m.EndColumn + let iLen = if lineA = lineB then max (iB - iA) 1 else 1 + Printf.bprintf buf "%s%s\n" prefix line + Printf.bprintf buf "%s%s%s\n" prefix (String.make iA '-') (String.make iLen '^') + + member diagnostic.WriteWithContext (os, prefix, fileLineFunction, tcConfig, severity) = + writeViaBuffer os (fun buf -> + diagnostic.OutputContext (buf, prefix, fileLineFunction) + diagnostic.Output (buf, tcConfig, severity) + ) //---------------------------------------------------------------------------- // Scoped #nowarn pragmas diff --git a/src/Compiler/Driver/CompilerDiagnostics.fsi b/src/Compiler/Driver/CompilerDiagnostics.fsi index 579e24079c7..8c1c9defe92 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fsi +++ b/src/Compiler/Driver/CompilerDiagnostics.fsi @@ -4,6 +4,7 @@ module internal FSharp.Compiler.CompilerDiagnostics open System.Text +open FSharp.Compiler.CompilerConfig open FSharp.Compiler.Diagnostics open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Syntax @@ -70,20 +71,21 @@ type PhasedDiagnostic with /// Indicates if we should report a warning as an error member ReportAsError: FSharpDiagnosticOptions * FSharpDiagnosticSeverity -> bool -/// Output an error or warning to a buffer -val OutputDiagnostic: - implicitIncludeDir: string * - showFullPaths: bool * - flattenErrors: bool * - diagnosticStyle: DiagnosticStyle * - severity: FSharpDiagnosticSeverity -> - StringBuilder -> - PhasedDiagnostic -> + /// Output all of a diagnostic to a buffer, including range + member Output: + buf: StringBuilder * + tcConfig: TcConfig * + severity: FSharpDiagnosticSeverity -> unit -/// Output extra context information for an error or warning to a buffer -val OutputDiagnosticContext: - prefix: string -> fileLineFunction: (string -> int -> string) -> StringBuilder -> PhasedDiagnostic -> unit + /// Write extra context information for a diagnostic + member WriteWithContext: + os: System.IO.TextWriter * + prefix: string * + fileLineFunction: (string -> int -> string) * + tcConfig: TcConfig * + severity: FSharpDiagnosticSeverity -> + unit /// Get an error logger that filters the reporting of warnings based on scoped pragma information val GetDiagnosticsLoggerFilteringByScopedPragmas: @@ -125,10 +127,7 @@ type FormattedDiagnostic = /// Used internally and in LegacyHostedCompilerForTesting val CollectFormattedDiagnostics: - implicitIncludeDir: string * - showFullPaths: bool * - flattenErrors: bool * - diagnosticStyle: DiagnosticStyle * + tcConfig: TcConfig * severity: FSharpDiagnosticSeverity * PhasedDiagnostic * suggestNames: bool -> diff --git a/src/Compiler/Driver/ScriptClosure.fs b/src/Compiler/Driver/ScriptClosure.fs index 45c7aa5a0f5..dc830aadf16 100644 --- a/src/Compiler/Driver/ScriptClosure.fs +++ b/src/Compiler/Driver/ScriptClosure.fs @@ -585,8 +585,8 @@ module ScriptPreprocessClosure = (parseDiagnostics @ earlierDiagnostics @ metaDiagnostics @ resolutionDiagnostics) | _ -> [], [] // When no file existed. - let isRootRange exn = - match GetRangeOfDiagnostic exn with + let isRootRange (diagnostic: PhasedDiagnostic)= + match diagnostic.Range with | Some m -> // Return true if the error was *not* from a #load-ed file. let isArgParameterWhileNotEditing = diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 83d5577b4e4..3be283306d5 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -68,7 +68,7 @@ type DiagnosticsLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, let mutable errors = 0 /// Called when an error or warning occurs - abstract HandleIssue: tcConfigB: TcConfigBuilder * diagnostic: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit + abstract HandleIssue: tcConfig: TcConfig * diagnostic: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit /// Called when 'too many errors' has occurred abstract HandleTooManyErrors: text: string -> unit @@ -76,12 +76,13 @@ type DiagnosticsLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, override _.ErrorCount = errors override x.DiagnosticSink(diagnostic, severity) = - if diagnostic.ReportAsError (tcConfigB.diagnosticsOptions, severity) then - if errors >= tcConfigB.maxErrors then + let tcConfig = TcConfig.Create(tcConfigB, validate = false) + if diagnostic.ReportAsError (tcConfig.diagnosticsOptions, severity) then + if errors >= tcConfig.maxErrors then x.HandleTooManyErrors(FSComp.SR.fscTooManyErrors ()) exiter.Exit 1 - x.HandleIssue(tcConfigB, diagnostic, FSharpDiagnosticSeverity.Error) + x.HandleIssue(tcConfig, diagnostic, FSharpDiagnosticSeverity.Error) errors <- errors + 1 @@ -92,11 +93,11 @@ type DiagnosticsLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, Debug.Assert(false, sprintf "Lookup exception in compiler: %s" (diagnostic.Exception.ToString())) | _ -> () - elif diagnostic.ReportAsWarning (tcConfigB.diagnosticsOptions, severity) then - x.HandleIssue(tcConfigB, diagnostic, FSharpDiagnosticSeverity.Warning) + elif diagnostic.ReportAsWarning (tcConfig.diagnosticsOptions, severity) then + x.HandleIssue(tcConfig, diagnostic, FSharpDiagnosticSeverity.Warning) - elif diagnostic.ReportAsInfo (tcConfigB.diagnosticsOptions, severity) then - x.HandleIssue(tcConfigB, diagnostic, severity) + elif diagnostic.ReportAsInfo (tcConfig.diagnosticsOptions, severity) then + x.HandleIssue(tcConfig, diagnostic, severity) /// Create an error logger that counts and prints errors let ConsoleDiagnosticsLogger (tcConfigB: TcConfigBuilder, exiter: Exiter) = @@ -105,18 +106,15 @@ let ConsoleDiagnosticsLogger (tcConfigB: TcConfigBuilder, exiter: Exiter) = member _.HandleTooManyErrors(text: string) = DoWithDiagnosticColor FSharpDiagnosticSeverity.Warning (fun () -> Printf.eprintfn "%s" text) - member _.HandleIssue(tcConfigB, err, severity) = + member _.HandleIssue(tcConfig, diagnostic, severity) = DoWithDiagnosticColor severity (fun () -> - let diagnostic = - OutputDiagnostic( - tcConfigB.implicitIncludeDir, - tcConfigB.showFullPaths, - tcConfigB.flatErrors, - tcConfigB.diagnosticStyle, + writeViaBuffer stderr (fun buf -> + diagnostic.Output( + buf, + tcConfig, severity ) - - writeViaBuffer stderr diagnostic err + ) stderr.WriteLine()) } :> DiagnosticsLogger @@ -338,12 +336,11 @@ module InterfaceFileWriter = } let writeToFile os (CheckedImplFile (contents = mexpr)) = - writeViaBuffer - os - (fun os s -> Printf.bprintf os "%s\n\n" s) - (NicePrint.layoutImpliedSignatureOfModuleOrNamespace true denv infoReader AccessibleFromSomewhere range0 mexpr - |> Display.squashTo 80 - |> LayoutRender.showL) + let text = + NicePrint.layoutImpliedSignatureOfModuleOrNamespace true denv infoReader AccessibleFromSomewhere range0 mexpr + |> Display.squashTo 80 + |> LayoutRender.showL + Printf.fprintf os "%s\n\n" text let writeHeader filePath os = if diff --git a/src/Compiler/Driver/fsc.fsi b/src/Compiler/Driver/fsc.fsi index 79f8f534185..51b7f2396b6 100644 --- a/src/Compiler/Driver/fsc.fsi +++ b/src/Compiler/Driver/fsc.fsi @@ -34,7 +34,7 @@ type DiagnosticsLoggerUpToMaxErrors = /// Called when a diagnostic occurs abstract HandleIssue: - tcConfigB: TcConfigBuilder * diagnostic: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit + tcConfig: TcConfig * diagnostic: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit /// Called when 'too many errors' has occurred abstract HandleTooManyErrors: text: string -> unit diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 0b0570fddca..122c51662cc 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -726,13 +726,12 @@ type internal FsiStdinSyphon(errorWriter: TextWriter) = if 0 < i && i <= lines.Length then lines[i-1] else "" /// Display the given error. - member syphon.PrintError (tcConfig:TcConfigBuilder, err) = + member syphon.PrintDiagnostic (tcConfig:TcConfig, diagnostic: PhasedDiagnostic) = ignoreAllErrors (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.diagnosticStyle,severity)) err + diagnostic.WriteWithContext(errorWriter, " ", syphon.GetLine, tcConfig, severity) errorWriter.WriteLine() errorWriter.WriteLine() errorWriter.Flush())) @@ -773,26 +772,25 @@ type internal DiagnosticsLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, member _.ResetErrorCount() = errorCount <- 0 - override _.DiagnosticSink(err, severity) = - if err.ReportAsError (tcConfigB.diagnosticsOptions, severity) then - fsiStdinSyphon.PrintError(tcConfigB,err) + override _.DiagnosticSink(diagnostic, severity) = + let tcConfig = TcConfig.Create(tcConfigB,validate=false) + if diagnostic.ReportAsError (tcConfig.diagnosticsOptions, severity) then + fsiStdinSyphon.PrintDiagnostic(tcConfig,diagnostic) errorCount <- errorCount + 1 if tcConfigB.abortOnError then exit 1 (* non-zero exit code *) // STOP ON FIRST ERROR (AVOIDS PARSER ERROR RECOVERY) raise StopProcessing - elif err.ReportAsWarning (tcConfigB.diagnosticsOptions, severity) then + elif diagnostic.ReportAsWarning (tcConfig.diagnosticsOptions, severity) then DoWithDiagnosticColor FSharpDiagnosticSeverity.Warning (fun () -> fsiConsoleOutput.Error.WriteLine() - writeViaBuffer fsiConsoleOutput.Error (OutputDiagnosticContext " " fsiStdinSyphon.GetLine) err - writeViaBuffer fsiConsoleOutput.Error (OutputDiagnostic (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.diagnosticStyle,severity)) err + diagnostic.WriteWithContext(fsiConsoleOutput.Error, " ", fsiStdinSyphon.GetLine, tcConfig, severity) fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.Flush()) - elif err.ReportAsInfo (tcConfigB.diagnosticsOptions, severity) then + elif diagnostic.ReportAsInfo (tcConfig.diagnosticsOptions, severity) then DoWithDiagnosticColor FSharpDiagnosticSeverity.Info (fun () -> fsiConsoleOutput.Error.WriteLine() - writeViaBuffer fsiConsoleOutput.Error (OutputDiagnosticContext " " fsiStdinSyphon.GetLine) err - writeViaBuffer fsiConsoleOutput.Error (OutputDiagnostic (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.diagnosticStyle,severity)) err + diagnostic.WriteWithContext(fsiConsoleOutput.Error, " ", fsiStdinSyphon.GetLine, tcConfig, severity) fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.Flush()) diff --git a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs index abfa2d2bbdb..c8a73fdba36 100644 --- a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs +++ b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs @@ -33,15 +33,12 @@ type internal InProcDiagnosticsLoggerProvider() = member _.HandleTooManyErrors text = warnings.Add(FormattedDiagnostic.Short(FSharpDiagnosticSeverity.Warning, text)) - member _.HandleIssue(tcConfigB, err, severity) = + member _.HandleIssue(tcConfig, 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 diagnostics = - CollectFormattedDiagnostics - (tcConfigB.implicitIncludeDir, tcConfigB.showFullPaths, - tcConfigB.flatErrors, tcConfigB.diagnosticStyle, severity, err, true) + let diagnostics = CollectFormattedDiagnostics (tcConfig, severity, err, true) match severity with | FSharpDiagnosticSeverity.Error -> - errors.AddRange(diagnostics) + errors.AddRange(diagnostics) | FSharpDiagnosticSeverity.Warning -> warnings.AddRange(diagnostics) | _ -> ()} diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 364d2c3703d..276027bb3d9 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -2397,8 +2397,8 @@ module internal ParseAndCheckFile = // If there was a loadClosure, replay the errors and warnings from resolution, excluding parsing loadClosure.LoadClosureRootFileDiagnostics |> List.iter diagnosticSink - let fileOfBackgroundError err = - match GetRangeOfDiagnostic(fst err) with + let fileOfBackgroundError (diagnostic: PhasedDiagnostic, _) = + match diagnostic.Range with | Some m -> Some m.FileName | None -> None diff --git a/src/Compiler/Utilities/lib.fs b/src/Compiler/Utilities/lib.fs index 1dc1429d408..95a20226a2d 100755 --- a/src/Compiler/Utilities/lib.fs +++ b/src/Compiler/Utilities/lib.fs @@ -321,9 +321,9 @@ let buildString f = buf.ToString() /// Writing to output stream via a string buffer. -let writeViaBuffer (os: TextWriter) f x = +let writeViaBuffer (os: TextWriter) f = let buf = StringBuilder 100 - f buf x + f buf os.Write(buf.ToString()) type StringBuilder with diff --git a/src/Compiler/Utilities/lib.fsi b/src/Compiler/Utilities/lib.fsi index fa482500064..bab85ccd414 100644 --- a/src/Compiler/Utilities/lib.fsi +++ b/src/Compiler/Utilities/lib.fsi @@ -230,7 +230,7 @@ val equalOn: f: ('a -> 'b) -> x: 'a -> y: 'a -> bool when 'b: equality val buildString: f: (StringBuilder -> unit) -> string /// Writing to output stream via a string buffer. -val writeViaBuffer: os: TextWriter -> f: (StringBuilder -> 'a -> unit) -> x: 'a -> unit +val writeViaBuffer: os: TextWriter -> f: (StringBuilder -> unit) -> unit type StringBuilder with From 13ff391fcc0677a1c80e33f6871c38749e06dfa7 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 24 Aug 2022 15:03:10 +0100 Subject: [PATCH 11/33] further cleanup --- src/Compiler/Driver/CompilerDiagnostics.fs | 339 +++++++++--------- src/Compiler/Driver/CompilerDiagnostics.fsi | 12 +- vsintegration/tests/UnitTests/Tests.Watson.fs | 4 +- 3 files changed, 177 insertions(+), 178 deletions(-) diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index e58a2ad9f9f..22df75e7901 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -42,9 +42,7 @@ open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps #if DEBUG -[] -module internal CompilerService = - let showAssertForUnexpectedException = ref true +let showAssertForUnexpectedException = ref true #endif /// This exception is an old-style way of reporting a diagnostic @@ -387,6 +385,7 @@ type PhasedDiagnostic with || (severity = FSharpDiagnosticSeverity.Warning && level >= x.WarningLevel) + /// Indicates if a diagnostic should be reported as an informational member x.ReportAsInfo (options, severity) = match severity with | FSharpDiagnosticSeverity.Error -> false @@ -396,6 +395,7 @@ type PhasedDiagnostic with && not (List.contains x.Number options.WarnOff) | FSharpDiagnosticSeverity.Hidden -> false + /// Indicates if a diagnostic should be reported as a warning member x.ReportAsWarning (options, severity) = match severity with | FSharpDiagnosticSeverity.Error -> false @@ -411,6 +411,7 @@ type PhasedDiagnostic with | FSharpDiagnosticSeverity.Hidden -> false + /// Indicates if a diagnostic should be reported as an error member x.ReportAsError (options, severity) = match severity with @@ -596,8 +597,6 @@ module OldStyleMessages = let MSBuildReferenceResolutionErrorE () = Message("MSBuildReferenceResolutionError", "%s%s") let TargetInvocationExceptionWrapperE () = Message("TargetInvocationExceptionWrapper", "%s") - let getErrorString key = SR.GetString key - #if DEBUG let mutable showParserStackOnParseError = false #endif @@ -1018,7 +1017,7 @@ type Exception with let tokenIdToText tid = match tid with - | Parser.TOKEN_IDENT -> getErrorString ("Parser.TOKEN.IDENT") + | Parser.TOKEN_IDENT -> SR.GetString ("Parser.TOKEN.IDENT") | Parser.TOKEN_BIGNUM | Parser.TOKEN_INT8 | Parser.TOKEN_UINT8 @@ -1029,191 +1028,191 @@ type Exception with | Parser.TOKEN_INT64 | Parser.TOKEN_UINT64 | Parser.TOKEN_UNATIVEINT - | Parser.TOKEN_NATIVEINT -> getErrorString ("Parser.TOKEN.INT") + | Parser.TOKEN_NATIVEINT -> SR.GetString ("Parser.TOKEN.INT") | Parser.TOKEN_IEEE32 - | Parser.TOKEN_IEEE64 -> getErrorString ("Parser.TOKEN.FLOAT") - | Parser.TOKEN_DECIMAL -> getErrorString ("Parser.TOKEN.DECIMAL") - | Parser.TOKEN_CHAR -> getErrorString ("Parser.TOKEN.CHAR") - - | Parser.TOKEN_BASE -> getErrorString ("Parser.TOKEN.BASE") - | Parser.TOKEN_LPAREN_STAR_RPAREN -> getErrorString ("Parser.TOKEN.LPAREN.STAR.RPAREN") - | Parser.TOKEN_DOLLAR -> getErrorString ("Parser.TOKEN.DOLLAR") - | Parser.TOKEN_INFIX_STAR_STAR_OP -> getErrorString ("Parser.TOKEN.INFIX.STAR.STAR.OP") - | Parser.TOKEN_INFIX_COMPARE_OP -> getErrorString ("Parser.TOKEN.INFIX.COMPARE.OP") - | Parser.TOKEN_COLON_GREATER -> getErrorString ("Parser.TOKEN.COLON.GREATER") - | Parser.TOKEN_COLON_COLON -> getErrorString ("Parser.TOKEN.COLON.COLON") - | Parser.TOKEN_PERCENT_OP -> getErrorString ("Parser.TOKEN.PERCENT.OP") - | Parser.TOKEN_INFIX_AT_HAT_OP -> getErrorString ("Parser.TOKEN.INFIX.AT.HAT.OP") - | Parser.TOKEN_INFIX_BAR_OP -> getErrorString ("Parser.TOKEN.INFIX.BAR.OP") - | Parser.TOKEN_PLUS_MINUS_OP -> getErrorString ("Parser.TOKEN.PLUS.MINUS.OP") - | Parser.TOKEN_PREFIX_OP -> getErrorString ("Parser.TOKEN.PREFIX.OP") - | Parser.TOKEN_COLON_QMARK_GREATER -> getErrorString ("Parser.TOKEN.COLON.QMARK.GREATER") - | Parser.TOKEN_INFIX_STAR_DIV_MOD_OP -> getErrorString ("Parser.TOKEN.INFIX.STAR.DIV.MOD.OP") - | Parser.TOKEN_INFIX_AMP_OP -> getErrorString ("Parser.TOKEN.INFIX.AMP.OP") - | Parser.TOKEN_AMP -> getErrorString ("Parser.TOKEN.AMP") - | Parser.TOKEN_AMP_AMP -> getErrorString ("Parser.TOKEN.AMP.AMP") - | Parser.TOKEN_BAR_BAR -> getErrorString ("Parser.TOKEN.BAR.BAR") - | Parser.TOKEN_LESS -> getErrorString ("Parser.TOKEN.LESS") - | Parser.TOKEN_GREATER -> getErrorString ("Parser.TOKEN.GREATER") - | Parser.TOKEN_QMARK -> getErrorString ("Parser.TOKEN.QMARK") - | Parser.TOKEN_QMARK_QMARK -> getErrorString ("Parser.TOKEN.QMARK.QMARK") - | Parser.TOKEN_COLON_QMARK -> getErrorString ("Parser.TOKEN.COLON.QMARK") - | Parser.TOKEN_INT32_DOT_DOT -> getErrorString ("Parser.TOKEN.INT32.DOT.DOT") - | Parser.TOKEN_DOT_DOT -> getErrorString ("Parser.TOKEN.DOT.DOT") - | Parser.TOKEN_DOT_DOT_HAT -> getErrorString ("Parser.TOKEN.DOT.DOT") - | Parser.TOKEN_QUOTE -> getErrorString ("Parser.TOKEN.QUOTE") - | Parser.TOKEN_STAR -> getErrorString ("Parser.TOKEN.STAR") - | Parser.TOKEN_HIGH_PRECEDENCE_TYAPP -> getErrorString ("Parser.TOKEN.HIGH.PRECEDENCE.TYAPP") - | Parser.TOKEN_COLON -> getErrorString ("Parser.TOKEN.COLON") - | Parser.TOKEN_COLON_EQUALS -> getErrorString ("Parser.TOKEN.COLON.EQUALS") - | Parser.TOKEN_LARROW -> getErrorString ("Parser.TOKEN.LARROW") - | Parser.TOKEN_EQUALS -> getErrorString ("Parser.TOKEN.EQUALS") - | Parser.TOKEN_GREATER_BAR_RBRACK -> getErrorString ("Parser.TOKEN.GREATER.BAR.RBRACK") - | Parser.TOKEN_MINUS -> getErrorString ("Parser.TOKEN.MINUS") - | Parser.TOKEN_ADJACENT_PREFIX_OP -> getErrorString ("Parser.TOKEN.ADJACENT.PREFIX.OP") - | Parser.TOKEN_FUNKY_OPERATOR_NAME -> getErrorString ("Parser.TOKEN.FUNKY.OPERATOR.NAME") - | Parser.TOKEN_COMMA -> getErrorString ("Parser.TOKEN.COMMA") - | Parser.TOKEN_DOT -> getErrorString ("Parser.TOKEN.DOT") - | Parser.TOKEN_BAR -> getErrorString ("Parser.TOKEN.BAR") - | Parser.TOKEN_HASH -> getErrorString ("Parser.TOKEN.HASH") - | Parser.TOKEN_UNDERSCORE -> getErrorString ("Parser.TOKEN.UNDERSCORE") - | Parser.TOKEN_SEMICOLON -> getErrorString ("Parser.TOKEN.SEMICOLON") - | Parser.TOKEN_SEMICOLON_SEMICOLON -> getErrorString ("Parser.TOKEN.SEMICOLON.SEMICOLON") - | Parser.TOKEN_LPAREN -> getErrorString ("Parser.TOKEN.LPAREN") + | Parser.TOKEN_IEEE64 -> SR.GetString ("Parser.TOKEN.FLOAT") + | Parser.TOKEN_DECIMAL -> SR.GetString ("Parser.TOKEN.DECIMAL") + | Parser.TOKEN_CHAR -> SR.GetString ("Parser.TOKEN.CHAR") + + | Parser.TOKEN_BASE -> SR.GetString ("Parser.TOKEN.BASE") + | Parser.TOKEN_LPAREN_STAR_RPAREN -> SR.GetString ("Parser.TOKEN.LPAREN.STAR.RPAREN") + | Parser.TOKEN_DOLLAR -> SR.GetString ("Parser.TOKEN.DOLLAR") + | Parser.TOKEN_INFIX_STAR_STAR_OP -> SR.GetString ("Parser.TOKEN.INFIX.STAR.STAR.OP") + | Parser.TOKEN_INFIX_COMPARE_OP -> SR.GetString ("Parser.TOKEN.INFIX.COMPARE.OP") + | Parser.TOKEN_COLON_GREATER -> SR.GetString ("Parser.TOKEN.COLON.GREATER") + | Parser.TOKEN_COLON_COLON -> SR.GetString ("Parser.TOKEN.COLON.COLON") + | Parser.TOKEN_PERCENT_OP -> SR.GetString ("Parser.TOKEN.PERCENT.OP") + | Parser.TOKEN_INFIX_AT_HAT_OP -> SR.GetString ("Parser.TOKEN.INFIX.AT.HAT.OP") + | Parser.TOKEN_INFIX_BAR_OP -> SR.GetString ("Parser.TOKEN.INFIX.BAR.OP") + | Parser.TOKEN_PLUS_MINUS_OP -> SR.GetString ("Parser.TOKEN.PLUS.MINUS.OP") + | Parser.TOKEN_PREFIX_OP -> SR.GetString ("Parser.TOKEN.PREFIX.OP") + | Parser.TOKEN_COLON_QMARK_GREATER -> SR.GetString ("Parser.TOKEN.COLON.QMARK.GREATER") + | Parser.TOKEN_INFIX_STAR_DIV_MOD_OP -> SR.GetString ("Parser.TOKEN.INFIX.STAR.DIV.MOD.OP") + | Parser.TOKEN_INFIX_AMP_OP -> SR.GetString ("Parser.TOKEN.INFIX.AMP.OP") + | Parser.TOKEN_AMP -> SR.GetString ("Parser.TOKEN.AMP") + | Parser.TOKEN_AMP_AMP -> SR.GetString ("Parser.TOKEN.AMP.AMP") + | Parser.TOKEN_BAR_BAR -> SR.GetString ("Parser.TOKEN.BAR.BAR") + | Parser.TOKEN_LESS -> SR.GetString ("Parser.TOKEN.LESS") + | Parser.TOKEN_GREATER -> SR.GetString ("Parser.TOKEN.GREATER") + | Parser.TOKEN_QMARK -> SR.GetString ("Parser.TOKEN.QMARK") + | Parser.TOKEN_QMARK_QMARK -> SR.GetString ("Parser.TOKEN.QMARK.QMARK") + | Parser.TOKEN_COLON_QMARK -> SR.GetString ("Parser.TOKEN.COLON.QMARK") + | Parser.TOKEN_INT32_DOT_DOT -> SR.GetString ("Parser.TOKEN.INT32.DOT.DOT") + | Parser.TOKEN_DOT_DOT -> SR.GetString ("Parser.TOKEN.DOT.DOT") + | Parser.TOKEN_DOT_DOT_HAT -> SR.GetString ("Parser.TOKEN.DOT.DOT") + | Parser.TOKEN_QUOTE -> SR.GetString ("Parser.TOKEN.QUOTE") + | Parser.TOKEN_STAR -> SR.GetString ("Parser.TOKEN.STAR") + | Parser.TOKEN_HIGH_PRECEDENCE_TYAPP -> SR.GetString ("Parser.TOKEN.HIGH.PRECEDENCE.TYAPP") + | Parser.TOKEN_COLON -> SR.GetString ("Parser.TOKEN.COLON") + | Parser.TOKEN_COLON_EQUALS -> SR.GetString ("Parser.TOKEN.COLON.EQUALS") + | Parser.TOKEN_LARROW -> SR.GetString ("Parser.TOKEN.LARROW") + | Parser.TOKEN_EQUALS -> SR.GetString ("Parser.TOKEN.EQUALS") + | Parser.TOKEN_GREATER_BAR_RBRACK -> SR.GetString ("Parser.TOKEN.GREATER.BAR.RBRACK") + | Parser.TOKEN_MINUS -> SR.GetString ("Parser.TOKEN.MINUS") + | Parser.TOKEN_ADJACENT_PREFIX_OP -> SR.GetString ("Parser.TOKEN.ADJACENT.PREFIX.OP") + | Parser.TOKEN_FUNKY_OPERATOR_NAME -> SR.GetString ("Parser.TOKEN.FUNKY.OPERATOR.NAME") + | Parser.TOKEN_COMMA -> SR.GetString ("Parser.TOKEN.COMMA") + | Parser.TOKEN_DOT -> SR.GetString ("Parser.TOKEN.DOT") + | Parser.TOKEN_BAR -> SR.GetString ("Parser.TOKEN.BAR") + | Parser.TOKEN_HASH -> SR.GetString ("Parser.TOKEN.HASH") + | Parser.TOKEN_UNDERSCORE -> SR.GetString ("Parser.TOKEN.UNDERSCORE") + | Parser.TOKEN_SEMICOLON -> SR.GetString ("Parser.TOKEN.SEMICOLON") + | Parser.TOKEN_SEMICOLON_SEMICOLON -> SR.GetString ("Parser.TOKEN.SEMICOLON.SEMICOLON") + | Parser.TOKEN_LPAREN -> SR.GetString ("Parser.TOKEN.LPAREN") | Parser.TOKEN_RPAREN | Parser.TOKEN_RPAREN_COMING_SOON - | Parser.TOKEN_RPAREN_IS_HERE -> getErrorString ("Parser.TOKEN.RPAREN") - | Parser.TOKEN_LQUOTE -> getErrorString ("Parser.TOKEN.LQUOTE") - | Parser.TOKEN_LBRACK -> getErrorString ("Parser.TOKEN.LBRACK") - | Parser.TOKEN_LBRACE_BAR -> getErrorString ("Parser.TOKEN.LBRACE.BAR") - | Parser.TOKEN_LBRACK_BAR -> getErrorString ("Parser.TOKEN.LBRACK.BAR") - | Parser.TOKEN_LBRACK_LESS -> getErrorString ("Parser.TOKEN.LBRACK.LESS") - | Parser.TOKEN_LBRACE -> getErrorString ("Parser.TOKEN.LBRACE") - | Parser.TOKEN_BAR_RBRACK -> getErrorString ("Parser.TOKEN.BAR.RBRACK") - | Parser.TOKEN_BAR_RBRACE -> getErrorString ("Parser.TOKEN.BAR.RBRACE") - | Parser.TOKEN_GREATER_RBRACK -> getErrorString ("Parser.TOKEN.GREATER.RBRACK") + | Parser.TOKEN_RPAREN_IS_HERE -> SR.GetString ("Parser.TOKEN.RPAREN") + | Parser.TOKEN_LQUOTE -> SR.GetString ("Parser.TOKEN.LQUOTE") + | Parser.TOKEN_LBRACK -> SR.GetString ("Parser.TOKEN.LBRACK") + | Parser.TOKEN_LBRACE_BAR -> SR.GetString ("Parser.TOKEN.LBRACE.BAR") + | Parser.TOKEN_LBRACK_BAR -> SR.GetString ("Parser.TOKEN.LBRACK.BAR") + | Parser.TOKEN_LBRACK_LESS -> SR.GetString ("Parser.TOKEN.LBRACK.LESS") + | Parser.TOKEN_LBRACE -> SR.GetString ("Parser.TOKEN.LBRACE") + | Parser.TOKEN_BAR_RBRACK -> SR.GetString ("Parser.TOKEN.BAR.RBRACK") + | Parser.TOKEN_BAR_RBRACE -> SR.GetString ("Parser.TOKEN.BAR.RBRACE") + | Parser.TOKEN_GREATER_RBRACK -> SR.GetString ("Parser.TOKEN.GREATER.RBRACK") | Parser.TOKEN_RQUOTE_DOT _ - | Parser.TOKEN_RQUOTE -> getErrorString ("Parser.TOKEN.RQUOTE") - | Parser.TOKEN_RBRACK -> getErrorString ("Parser.TOKEN.RBRACK") + | Parser.TOKEN_RQUOTE -> SR.GetString ("Parser.TOKEN.RQUOTE") + | Parser.TOKEN_RBRACK -> SR.GetString ("Parser.TOKEN.RBRACK") | Parser.TOKEN_RBRACE | Parser.TOKEN_RBRACE_COMING_SOON - | Parser.TOKEN_RBRACE_IS_HERE -> getErrorString ("Parser.TOKEN.RBRACE") - | Parser.TOKEN_PUBLIC -> getErrorString ("Parser.TOKEN.PUBLIC") - | Parser.TOKEN_PRIVATE -> getErrorString ("Parser.TOKEN.PRIVATE") - | Parser.TOKEN_INTERNAL -> getErrorString ("Parser.TOKEN.INTERNAL") - | Parser.TOKEN_CONSTRAINT -> getErrorString ("Parser.TOKEN.CONSTRAINT") - | Parser.TOKEN_INSTANCE -> getErrorString ("Parser.TOKEN.INSTANCE") - | Parser.TOKEN_DELEGATE -> getErrorString ("Parser.TOKEN.DELEGATE") - | Parser.TOKEN_INHERIT -> getErrorString ("Parser.TOKEN.INHERIT") - | Parser.TOKEN_CONSTRUCTOR -> getErrorString ("Parser.TOKEN.CONSTRUCTOR") - | Parser.TOKEN_DEFAULT -> getErrorString ("Parser.TOKEN.DEFAULT") - | Parser.TOKEN_OVERRIDE -> getErrorString ("Parser.TOKEN.OVERRIDE") - | Parser.TOKEN_ABSTRACT -> getErrorString ("Parser.TOKEN.ABSTRACT") - | Parser.TOKEN_CLASS -> getErrorString ("Parser.TOKEN.CLASS") - | Parser.TOKEN_MEMBER -> getErrorString ("Parser.TOKEN.MEMBER") - | Parser.TOKEN_STATIC -> getErrorString ("Parser.TOKEN.STATIC") - | Parser.TOKEN_NAMESPACE -> getErrorString ("Parser.TOKEN.NAMESPACE") - | Parser.TOKEN_OBLOCKBEGIN -> getErrorString ("Parser.TOKEN.OBLOCKBEGIN") - | EndOfStructuredConstructToken -> getErrorString ("Parser.TOKEN.OBLOCKEND") + | Parser.TOKEN_RBRACE_IS_HERE -> SR.GetString ("Parser.TOKEN.RBRACE") + | Parser.TOKEN_PUBLIC -> SR.GetString ("Parser.TOKEN.PUBLIC") + | Parser.TOKEN_PRIVATE -> SR.GetString ("Parser.TOKEN.PRIVATE") + | Parser.TOKEN_INTERNAL -> SR.GetString ("Parser.TOKEN.INTERNAL") + | Parser.TOKEN_CONSTRAINT -> SR.GetString ("Parser.TOKEN.CONSTRAINT") + | Parser.TOKEN_INSTANCE -> SR.GetString ("Parser.TOKEN.INSTANCE") + | Parser.TOKEN_DELEGATE -> SR.GetString ("Parser.TOKEN.DELEGATE") + | Parser.TOKEN_INHERIT -> SR.GetString ("Parser.TOKEN.INHERIT") + | Parser.TOKEN_CONSTRUCTOR -> SR.GetString ("Parser.TOKEN.CONSTRUCTOR") + | Parser.TOKEN_DEFAULT -> SR.GetString ("Parser.TOKEN.DEFAULT") + | Parser.TOKEN_OVERRIDE -> SR.GetString ("Parser.TOKEN.OVERRIDE") + | Parser.TOKEN_ABSTRACT -> SR.GetString ("Parser.TOKEN.ABSTRACT") + | Parser.TOKEN_CLASS -> SR.GetString ("Parser.TOKEN.CLASS") + | Parser.TOKEN_MEMBER -> SR.GetString ("Parser.TOKEN.MEMBER") + | Parser.TOKEN_STATIC -> SR.GetString ("Parser.TOKEN.STATIC") + | Parser.TOKEN_NAMESPACE -> SR.GetString ("Parser.TOKEN.NAMESPACE") + | Parser.TOKEN_OBLOCKBEGIN -> SR.GetString ("Parser.TOKEN.OBLOCKBEGIN") + | EndOfStructuredConstructToken -> SR.GetString ("Parser.TOKEN.OBLOCKEND") | Parser.TOKEN_THEN - | Parser.TOKEN_OTHEN -> getErrorString ("Parser.TOKEN.OTHEN") + | Parser.TOKEN_OTHEN -> SR.GetString ("Parser.TOKEN.OTHEN") | Parser.TOKEN_ELSE - | Parser.TOKEN_OELSE -> getErrorString ("Parser.TOKEN.OELSE") + | Parser.TOKEN_OELSE -> SR.GetString ("Parser.TOKEN.OELSE") | Parser.TOKEN_LET _ - | Parser.TOKEN_OLET _ -> getErrorString ("Parser.TOKEN.OLET") + | Parser.TOKEN_OLET _ -> SR.GetString ("Parser.TOKEN.OLET") | Parser.TOKEN_OBINDER - | Parser.TOKEN_BINDER -> getErrorString ("Parser.TOKEN.BINDER") + | Parser.TOKEN_BINDER -> SR.GetString ("Parser.TOKEN.BINDER") | Parser.TOKEN_OAND_BANG - | Parser.TOKEN_AND_BANG -> getErrorString ("Parser.TOKEN.AND.BANG") - | Parser.TOKEN_ODO -> getErrorString ("Parser.TOKEN.ODO") - | Parser.TOKEN_OWITH -> getErrorString ("Parser.TOKEN.OWITH") - | Parser.TOKEN_OFUNCTION -> getErrorString ("Parser.TOKEN.OFUNCTION") - | Parser.TOKEN_OFUN -> getErrorString ("Parser.TOKEN.OFUN") - | Parser.TOKEN_ORESET -> getErrorString ("Parser.TOKEN.ORESET") - | Parser.TOKEN_ODUMMY -> getErrorString ("Parser.TOKEN.ODUMMY") + | Parser.TOKEN_AND_BANG -> SR.GetString ("Parser.TOKEN.AND.BANG") + | Parser.TOKEN_ODO -> SR.GetString ("Parser.TOKEN.ODO") + | Parser.TOKEN_OWITH -> SR.GetString ("Parser.TOKEN.OWITH") + | Parser.TOKEN_OFUNCTION -> SR.GetString ("Parser.TOKEN.OFUNCTION") + | Parser.TOKEN_OFUN -> SR.GetString ("Parser.TOKEN.OFUN") + | Parser.TOKEN_ORESET -> SR.GetString ("Parser.TOKEN.ORESET") + | Parser.TOKEN_ODUMMY -> SR.GetString ("Parser.TOKEN.ODUMMY") | Parser.TOKEN_DO_BANG - | Parser.TOKEN_ODO_BANG -> getErrorString ("Parser.TOKEN.ODO.BANG") - | Parser.TOKEN_YIELD -> getErrorString ("Parser.TOKEN.YIELD") - | Parser.TOKEN_YIELD_BANG -> getErrorString ("Parser.TOKEN.YIELD.BANG") - | Parser.TOKEN_OINTERFACE_MEMBER -> getErrorString ("Parser.TOKEN.OINTERFACE.MEMBER") - | Parser.TOKEN_ELIF -> getErrorString ("Parser.TOKEN.ELIF") - | Parser.TOKEN_RARROW -> getErrorString ("Parser.TOKEN.RARROW") - | Parser.TOKEN_SIG -> getErrorString ("Parser.TOKEN.SIG") - | Parser.TOKEN_STRUCT -> getErrorString ("Parser.TOKEN.STRUCT") - | Parser.TOKEN_UPCAST -> getErrorString ("Parser.TOKEN.UPCAST") - | Parser.TOKEN_DOWNCAST -> getErrorString ("Parser.TOKEN.DOWNCAST") - | Parser.TOKEN_NULL -> getErrorString ("Parser.TOKEN.NULL") - | Parser.TOKEN_RESERVED -> getErrorString ("Parser.TOKEN.RESERVED") + | Parser.TOKEN_ODO_BANG -> SR.GetString ("Parser.TOKEN.ODO.BANG") + | Parser.TOKEN_YIELD -> SR.GetString ("Parser.TOKEN.YIELD") + | Parser.TOKEN_YIELD_BANG -> SR.GetString ("Parser.TOKEN.YIELD.BANG") + | Parser.TOKEN_OINTERFACE_MEMBER -> SR.GetString ("Parser.TOKEN.OINTERFACE.MEMBER") + | Parser.TOKEN_ELIF -> SR.GetString ("Parser.TOKEN.ELIF") + | Parser.TOKEN_RARROW -> SR.GetString ("Parser.TOKEN.RARROW") + | Parser.TOKEN_SIG -> SR.GetString ("Parser.TOKEN.SIG") + | Parser.TOKEN_STRUCT -> SR.GetString ("Parser.TOKEN.STRUCT") + | Parser.TOKEN_UPCAST -> SR.GetString ("Parser.TOKEN.UPCAST") + | Parser.TOKEN_DOWNCAST -> SR.GetString ("Parser.TOKEN.DOWNCAST") + | Parser.TOKEN_NULL -> SR.GetString ("Parser.TOKEN.NULL") + | Parser.TOKEN_RESERVED -> SR.GetString ("Parser.TOKEN.RESERVED") | Parser.TOKEN_MODULE | Parser.TOKEN_MODULE_COMING_SOON - | Parser.TOKEN_MODULE_IS_HERE -> getErrorString ("Parser.TOKEN.MODULE") - | Parser.TOKEN_AND -> getErrorString ("Parser.TOKEN.AND") - | Parser.TOKEN_AS -> getErrorString ("Parser.TOKEN.AS") - | Parser.TOKEN_ASSERT -> getErrorString ("Parser.TOKEN.ASSERT") - | Parser.TOKEN_OASSERT -> getErrorString ("Parser.TOKEN.ASSERT") - | Parser.TOKEN_ASR -> getErrorString ("Parser.TOKEN.ASR") - | Parser.TOKEN_DOWNTO -> getErrorString ("Parser.TOKEN.DOWNTO") - | Parser.TOKEN_EXCEPTION -> getErrorString ("Parser.TOKEN.EXCEPTION") - | Parser.TOKEN_FALSE -> getErrorString ("Parser.TOKEN.FALSE") - | Parser.TOKEN_FOR -> getErrorString ("Parser.TOKEN.FOR") - | Parser.TOKEN_FUN -> getErrorString ("Parser.TOKEN.FUN") - | Parser.TOKEN_FUNCTION -> getErrorString ("Parser.TOKEN.FUNCTION") - | Parser.TOKEN_FINALLY -> getErrorString ("Parser.TOKEN.FINALLY") - | Parser.TOKEN_LAZY -> getErrorString ("Parser.TOKEN.LAZY") - | Parser.TOKEN_OLAZY -> getErrorString ("Parser.TOKEN.LAZY") - | Parser.TOKEN_MATCH -> getErrorString ("Parser.TOKEN.MATCH") - | Parser.TOKEN_MATCH_BANG -> getErrorString ("Parser.TOKEN.MATCH.BANG") - | Parser.TOKEN_MUTABLE -> getErrorString ("Parser.TOKEN.MUTABLE") - | Parser.TOKEN_NEW -> getErrorString ("Parser.TOKEN.NEW") - | Parser.TOKEN_OF -> getErrorString ("Parser.TOKEN.OF") - | Parser.TOKEN_OPEN -> getErrorString ("Parser.TOKEN.OPEN") - | Parser.TOKEN_OR -> getErrorString ("Parser.TOKEN.OR") - | Parser.TOKEN_VOID -> getErrorString ("Parser.TOKEN.VOID") - | Parser.TOKEN_EXTERN -> getErrorString ("Parser.TOKEN.EXTERN") - | Parser.TOKEN_INTERFACE -> getErrorString ("Parser.TOKEN.INTERFACE") - | Parser.TOKEN_REC -> getErrorString ("Parser.TOKEN.REC") - | Parser.TOKEN_TO -> getErrorString ("Parser.TOKEN.TO") - | Parser.TOKEN_TRUE -> getErrorString ("Parser.TOKEN.TRUE") - | Parser.TOKEN_TRY -> getErrorString ("Parser.TOKEN.TRY") + | Parser.TOKEN_MODULE_IS_HERE -> SR.GetString ("Parser.TOKEN.MODULE") + | Parser.TOKEN_AND -> SR.GetString ("Parser.TOKEN.AND") + | Parser.TOKEN_AS -> SR.GetString ("Parser.TOKEN.AS") + | Parser.TOKEN_ASSERT -> SR.GetString ("Parser.TOKEN.ASSERT") + | Parser.TOKEN_OASSERT -> SR.GetString ("Parser.TOKEN.ASSERT") + | Parser.TOKEN_ASR -> SR.GetString ("Parser.TOKEN.ASR") + | Parser.TOKEN_DOWNTO -> SR.GetString ("Parser.TOKEN.DOWNTO") + | Parser.TOKEN_EXCEPTION -> SR.GetString ("Parser.TOKEN.EXCEPTION") + | Parser.TOKEN_FALSE -> SR.GetString ("Parser.TOKEN.FALSE") + | Parser.TOKEN_FOR -> SR.GetString ("Parser.TOKEN.FOR") + | Parser.TOKEN_FUN -> SR.GetString ("Parser.TOKEN.FUN") + | Parser.TOKEN_FUNCTION -> SR.GetString ("Parser.TOKEN.FUNCTION") + | Parser.TOKEN_FINALLY -> SR.GetString ("Parser.TOKEN.FINALLY") + | Parser.TOKEN_LAZY -> SR.GetString ("Parser.TOKEN.LAZY") + | Parser.TOKEN_OLAZY -> SR.GetString ("Parser.TOKEN.LAZY") + | Parser.TOKEN_MATCH -> SR.GetString ("Parser.TOKEN.MATCH") + | Parser.TOKEN_MATCH_BANG -> SR.GetString ("Parser.TOKEN.MATCH.BANG") + | Parser.TOKEN_MUTABLE -> SR.GetString ("Parser.TOKEN.MUTABLE") + | Parser.TOKEN_NEW -> SR.GetString ("Parser.TOKEN.NEW") + | Parser.TOKEN_OF -> SR.GetString ("Parser.TOKEN.OF") + | Parser.TOKEN_OPEN -> SR.GetString ("Parser.TOKEN.OPEN") + | Parser.TOKEN_OR -> SR.GetString ("Parser.TOKEN.OR") + | Parser.TOKEN_VOID -> SR.GetString ("Parser.TOKEN.VOID") + | Parser.TOKEN_EXTERN -> SR.GetString ("Parser.TOKEN.EXTERN") + | Parser.TOKEN_INTERFACE -> SR.GetString ("Parser.TOKEN.INTERFACE") + | Parser.TOKEN_REC -> SR.GetString ("Parser.TOKEN.REC") + | Parser.TOKEN_TO -> SR.GetString ("Parser.TOKEN.TO") + | Parser.TOKEN_TRUE -> SR.GetString ("Parser.TOKEN.TRUE") + | Parser.TOKEN_TRY -> SR.GetString ("Parser.TOKEN.TRY") | Parser.TOKEN_TYPE | Parser.TOKEN_TYPE_COMING_SOON - | Parser.TOKEN_TYPE_IS_HERE -> getErrorString ("Parser.TOKEN.TYPE") - | Parser.TOKEN_VAL -> getErrorString ("Parser.TOKEN.VAL") - | Parser.TOKEN_INLINE -> getErrorString ("Parser.TOKEN.INLINE") - | Parser.TOKEN_WHEN -> getErrorString ("Parser.TOKEN.WHEN") - | Parser.TOKEN_WHILE -> getErrorString ("Parser.TOKEN.WHILE") - | Parser.TOKEN_WITH -> getErrorString ("Parser.TOKEN.WITH") - | Parser.TOKEN_IF -> getErrorString ("Parser.TOKEN.IF") - | Parser.TOKEN_DO -> getErrorString ("Parser.TOKEN.DO") - | Parser.TOKEN_GLOBAL -> getErrorString ("Parser.TOKEN.GLOBAL") - | Parser.TOKEN_DONE -> getErrorString ("Parser.TOKEN.DONE") + | Parser.TOKEN_TYPE_IS_HERE -> SR.GetString ("Parser.TOKEN.TYPE") + | Parser.TOKEN_VAL -> SR.GetString ("Parser.TOKEN.VAL") + | Parser.TOKEN_INLINE -> SR.GetString ("Parser.TOKEN.INLINE") + | Parser.TOKEN_WHEN -> SR.GetString ("Parser.TOKEN.WHEN") + | Parser.TOKEN_WHILE -> SR.GetString ("Parser.TOKEN.WHILE") + | Parser.TOKEN_WITH -> SR.GetString ("Parser.TOKEN.WITH") + | Parser.TOKEN_IF -> SR.GetString ("Parser.TOKEN.IF") + | Parser.TOKEN_DO -> SR.GetString ("Parser.TOKEN.DO") + | Parser.TOKEN_GLOBAL -> SR.GetString ("Parser.TOKEN.GLOBAL") + | Parser.TOKEN_DONE -> SR.GetString ("Parser.TOKEN.DONE") | Parser.TOKEN_IN - | Parser.TOKEN_JOIN_IN -> getErrorString ("Parser.TOKEN.IN") - | Parser.TOKEN_HIGH_PRECEDENCE_PAREN_APP -> getErrorString ("Parser.TOKEN.HIGH.PRECEDENCE.PAREN.APP") - | Parser.TOKEN_HIGH_PRECEDENCE_BRACK_APP -> getErrorString ("Parser.TOKEN.HIGH.PRECEDENCE.BRACK.APP") - | Parser.TOKEN_BEGIN -> getErrorString ("Parser.TOKEN.BEGIN") - | Parser.TOKEN_END -> getErrorString ("Parser.TOKEN.END") + | Parser.TOKEN_JOIN_IN -> SR.GetString ("Parser.TOKEN.IN") + | Parser.TOKEN_HIGH_PRECEDENCE_PAREN_APP -> SR.GetString ("Parser.TOKEN.HIGH.PRECEDENCE.PAREN.APP") + | Parser.TOKEN_HIGH_PRECEDENCE_BRACK_APP -> SR.GetString ("Parser.TOKEN.HIGH.PRECEDENCE.BRACK.APP") + | Parser.TOKEN_BEGIN -> SR.GetString ("Parser.TOKEN.BEGIN") + | Parser.TOKEN_END -> SR.GetString ("Parser.TOKEN.END") | Parser.TOKEN_HASH_LIGHT | Parser.TOKEN_HASH_LINE | Parser.TOKEN_HASH_IF | Parser.TOKEN_HASH_ELSE - | Parser.TOKEN_HASH_ENDIF -> getErrorString ("Parser.TOKEN.HASH.ENDIF") - | Parser.TOKEN_INACTIVECODE -> getErrorString ("Parser.TOKEN.INACTIVECODE") - | Parser.TOKEN_LEX_FAILURE -> getErrorString ("Parser.TOKEN.LEX.FAILURE") - | Parser.TOKEN_WHITESPACE -> getErrorString ("Parser.TOKEN.WHITESPACE") - | Parser.TOKEN_COMMENT -> getErrorString ("Parser.TOKEN.COMMENT") - | Parser.TOKEN_LINE_COMMENT -> getErrorString ("Parser.TOKEN.LINE.COMMENT") - | Parser.TOKEN_STRING_TEXT -> getErrorString ("Parser.TOKEN.STRING.TEXT") - | Parser.TOKEN_BYTEARRAY -> getErrorString ("Parser.TOKEN.BYTEARRAY") - | Parser.TOKEN_STRING -> getErrorString ("Parser.TOKEN.STRING") - | Parser.TOKEN_KEYWORD_STRING -> getErrorString ("Parser.TOKEN.KEYWORD_STRING") - | Parser.TOKEN_EOF -> getErrorString ("Parser.TOKEN.EOF") - | Parser.TOKEN_CONST -> getErrorString ("Parser.TOKEN.CONST") - | Parser.TOKEN_FIXED -> getErrorString ("Parser.TOKEN.FIXED") - | Parser.TOKEN_INTERP_STRING_BEGIN_END -> getErrorString ("Parser.TOKEN.INTERP.STRING.BEGIN.END") - | Parser.TOKEN_INTERP_STRING_BEGIN_PART -> getErrorString ("Parser.TOKEN.INTERP.STRING.BEGIN.PART") - | Parser.TOKEN_INTERP_STRING_PART -> getErrorString ("Parser.TOKEN.INTERP.STRING.PART") - | Parser.TOKEN_INTERP_STRING_END -> getErrorString ("Parser.TOKEN.INTERP.STRING.END") + | Parser.TOKEN_HASH_ENDIF -> SR.GetString ("Parser.TOKEN.HASH.ENDIF") + | Parser.TOKEN_INACTIVECODE -> SR.GetString ("Parser.TOKEN.INACTIVECODE") + | Parser.TOKEN_LEX_FAILURE -> SR.GetString ("Parser.TOKEN.LEX.FAILURE") + | Parser.TOKEN_WHITESPACE -> SR.GetString ("Parser.TOKEN.WHITESPACE") + | Parser.TOKEN_COMMENT -> SR.GetString ("Parser.TOKEN.COMMENT") + | Parser.TOKEN_LINE_COMMENT -> SR.GetString ("Parser.TOKEN.LINE.COMMENT") + | Parser.TOKEN_STRING_TEXT -> SR.GetString ("Parser.TOKEN.STRING.TEXT") + | Parser.TOKEN_BYTEARRAY -> SR.GetString ("Parser.TOKEN.BYTEARRAY") + | Parser.TOKEN_STRING -> SR.GetString ("Parser.TOKEN.STRING") + | Parser.TOKEN_KEYWORD_STRING -> SR.GetString ("Parser.TOKEN.KEYWORD_STRING") + | Parser.TOKEN_EOF -> SR.GetString ("Parser.TOKEN.EOF") + | Parser.TOKEN_CONST -> SR.GetString ("Parser.TOKEN.CONST") + | Parser.TOKEN_FIXED -> SR.GetString ("Parser.TOKEN.FIXED") + | Parser.TOKEN_INTERP_STRING_BEGIN_END -> SR.GetString ("Parser.TOKEN.INTERP.STRING.BEGIN.END") + | Parser.TOKEN_INTERP_STRING_BEGIN_PART -> SR.GetString ("Parser.TOKEN.INTERP.STRING.BEGIN.PART") + | Parser.TOKEN_INTERP_STRING_PART -> SR.GetString ("Parser.TOKEN.INTERP.STRING.PART") + | Parser.TOKEN_INTERP_STRING_END -> SR.GetString ("Parser.TOKEN.INTERP.STRING.END") | unknown -> Debug.Assert(false, "unknown token tag") let result = sprintf "%+A" unknown diff --git a/src/Compiler/Driver/CompilerDiagnostics.fsi b/src/Compiler/Driver/CompilerDiagnostics.fsi index 8c1c9defe92..5ab9d11e1df 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fsi +++ b/src/Compiler/Driver/CompilerDiagnostics.fsi @@ -11,8 +11,7 @@ open FSharp.Compiler.Syntax open FSharp.Compiler.Text #if DEBUG -module internal CompilerService = - val showAssertForUnexpectedException: bool ref +val showAssertForUnexpectedException: bool ref /// For extra diagnostics val mutable showParserStackOnParseError: bool @@ -62,13 +61,13 @@ type PhasedDiagnostic with /// Format the core of the diagnostic as a string. Doesn't include the range information. member FormatCore: flattenErrors: bool * suggestNames: bool -> string - /// Indicates if we should report a diagnostic as a warning + /// Indicates if a diagnostic should be reported as an informational member ReportAsInfo: FSharpDiagnosticOptions * FSharpDiagnosticSeverity -> bool - /// Indicates if we should report a diagnostic as a warning + /// Indicates if a diagnostic should be reported as a warning member ReportAsWarning: FSharpDiagnosticOptions * FSharpDiagnosticSeverity -> bool - /// Indicates if we should report a warning as an error + /// Indicates if a diagnostic should be reported as an error member ReportAsError: FSharpDiagnosticOptions * FSharpDiagnosticSeverity -> bool /// Output all of a diagnostic to a buffer, including range @@ -87,7 +86,7 @@ type PhasedDiagnostic with severity: FSharpDiagnosticSeverity -> unit -/// Get an error logger that filters the reporting of warnings based on scoped pragma information +/// Get a diagnostics logger that filters the reporting of warnings based on scoped pragma information val GetDiagnosticsLoggerFilteringByScopedPragmas: checkFile: bool * scopedPragmas: ScopedPragma list * @@ -95,6 +94,7 @@ val GetDiagnosticsLoggerFilteringByScopedPragmas: diagnosticsLogger: DiagnosticsLogger -> DiagnosticsLogger +/// Remove 'implicitIncludeDir' from a file name before output val SanitizeFileName: fileName: string -> implicitIncludeDir: string -> string /// Used internally and in LegacyHostedCompilerForTesting diff --git a/vsintegration/tests/UnitTests/Tests.Watson.fs b/vsintegration/tests/UnitTests/Tests.Watson.fs index 54122e4ff71..35ccf0f4d03 100644 --- a/vsintegration/tests/UnitTests/Tests.Watson.fs +++ b/vsintegration/tests/UnitTests/Tests.Watson.fs @@ -19,7 +19,7 @@ type Check = try try #if DEBUG - FSharp.Compiler.CompilerDiagnostics.CompilerService.showAssertForUnexpectedException := false + FSharp.Compiler.CompilerDiagnostics.showAssertForUnexpectedException := false #endif if (FileSystem.FileExistsShim("watson-test.fs")) then FileSystem.FileDeleteShim("watson-test.fs") @@ -46,7 +46,7 @@ type Check = Assert.Fail("An InternalError exception occurred.") finally #if DEBUG - FSharp.Compiler.CompilerDiagnostics.CompilerService.showAssertForUnexpectedException := true + FSharp.Compiler.CompilerDiagnostics.showAssertForUnexpectedException := true #endif FileSystem.FileDeleteShim("watson-test.fs") From 7d30b899f81383f350e5c9c80104669b0d69f41a Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 24 Aug 2022 15:31:10 +0100 Subject: [PATCH 12/33] format code --- src/Compiler/Checking/ConstraintSolver.fsi | 8 +- src/Compiler/Driver/CompilerDiagnostics.fs | 458 ++++++++++---------- src/Compiler/Driver/CompilerDiagnostics.fsi | 11 +- src/Compiler/Driver/ScriptClosure.fs | 2 +- src/Compiler/Driver/fsc.fs | 18 +- src/Compiler/Driver/fsc.fsi | 3 +- 6 files changed, 237 insertions(+), 263 deletions(-) diff --git a/src/Compiler/Checking/ConstraintSolver.fsi b/src/Compiler/Checking/ConstraintSolver.fsi index c04d808e68b..ca6a0bc4c47 100644 --- a/src/Compiler/Checking/ConstraintSolver.fsi +++ b/src/Compiler/Checking/ConstraintSolver.fsi @@ -170,7 +170,13 @@ exception ConstraintSolverMissingConstraint of displayEnv: DisplayEnv * Typar * exception ConstraintSolverError of string * range * range -exception ErrorFromApplyingDefault of tcGlobals: TcGlobals * displayEnv: DisplayEnv * Typar * TType * error: exn * range: range +exception ErrorFromApplyingDefault of + tcGlobals: TcGlobals * + displayEnv: DisplayEnv * + Typar * + TType * + error: exn * + range: range exception ErrorFromAddingTypeEquation of tcGlobals: TcGlobals * diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index 22df75e7901..82d27832db4 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -75,7 +75,7 @@ exception DeprecatedCommandLineOptionNoDescription of string * range /// This exception is an old-style way of reporting a diagnostic exception InternalCommandLineOption of string * range -type Exception with +type Exception with member exn.DiagnosticRange = match exn with @@ -338,13 +338,11 @@ type Exception with fst (FSComp.SR.considerUpcast ("", "")) | _ -> 193 +type PhasedDiagnostic with -type PhasedDiagnostic with - member x.Range = - x.Exception.DiagnosticRange + member x.Range = x.Exception.DiagnosticRange - member x.Number = - x.Exception.DiagnosticNumber + member x.Number = x.Exception.DiagnosticNumber member x.WarningLevel = match x.Exception with @@ -363,10 +361,11 @@ type PhasedDiagnostic with // Level 2 | _ -> 2 - member x.IsEnabled (severity, options) = + member x.IsEnabled(severity, options) = let level = options.WarnLevel let specificWarnOn = options.WarnOn let n = x.Number + List.contains n specificWarnOn || // Some specific warnings/informational are never on by default, i.e. unused variable warnings @@ -382,27 +381,22 @@ type PhasedDiagnostic with | 3395 -> false // tcImplicitConversionUsedForMethodArg - off by default | _ -> (severity = FSharpDiagnosticSeverity.Info) - || (severity = FSharpDiagnosticSeverity.Warning - && level >= x.WarningLevel) + || (severity = FSharpDiagnosticSeverity.Warning && level >= x.WarningLevel) /// Indicates if a diagnostic should be reported as an informational - member x.ReportAsInfo (options, severity) = + member x.ReportAsInfo(options, severity) = match severity with | FSharpDiagnosticSeverity.Error -> false | FSharpDiagnosticSeverity.Warning -> false - | FSharpDiagnosticSeverity.Info -> - x.IsEnabled (severity, options) - && not (List.contains x.Number options.WarnOff) + | FSharpDiagnosticSeverity.Info -> x.IsEnabled(severity, options) && not (List.contains x.Number options.WarnOff) | FSharpDiagnosticSeverity.Hidden -> false /// Indicates if a diagnostic should be reported as a warning - member x.ReportAsWarning (options, severity) = + member x.ReportAsWarning(options, severity) = match severity with | FSharpDiagnosticSeverity.Error -> false - | FSharpDiagnosticSeverity.Warning -> - x.IsEnabled (severity, options) - && not (List.contains x.Number options.WarnOff) + | FSharpDiagnosticSeverity.Warning -> x.IsEnabled(severity, options) && not (List.contains x.Number options.WarnOff) // Informational become warning if explicitly on and not explicitly off | FSharpDiagnosticSeverity.Info -> @@ -412,7 +406,7 @@ type PhasedDiagnostic with | FSharpDiagnosticSeverity.Hidden -> false /// Indicates if a diagnostic should be reported as an error - member x.ReportAsError (options, severity) = + member x.ReportAsError(options, severity) = match severity with | FSharpDiagnosticSeverity.Error -> true @@ -420,18 +414,17 @@ type PhasedDiagnostic with // Warnings become errors in some situations | FSharpDiagnosticSeverity.Warning -> let n = x.Number - x.IsEnabled (severity, options) + + x.IsEnabled(severity, options) && not (List.contains n options.WarnAsWarn) && ((options.GlobalWarnAsError && not (List.contains n options.WarnOff)) || List.contains n options.WarnAsError) // Informational become errors if explicitly WarnAsError - | FSharpDiagnosticSeverity.Info -> - List.contains x.Number options.WarnAsError + | FSharpDiagnosticSeverity.Info -> List.contains x.Number options.WarnAsError | FSharpDiagnosticSeverity.Hidden -> false - [] module OldStyleMessages = let Message (name, format) = DeclareResourceString(name, format) @@ -623,7 +616,8 @@ let OutputNameSuggestions (os: StringBuilder) canSuggestNames suggestionsF idTex os.AppendString(ConvertValLogicalNameToDisplayNameCore value) type Exception with - member exn.Output (os: StringBuilder, canSuggestNames) = + + member exn.Output(os: StringBuilder, canSuggestNames) = match exn with | ConstraintSolverTupleDiffLengths (_, tl1, tl2, m, m2) -> @@ -736,13 +730,11 @@ type Exception with | ContextInfo.NoContext -> false | _ -> true) -> - e.Output (os, canSuggestNames) + e.Output(os, canSuggestNames) - | ErrorFromAddingTypeEquation (error = ConstraintSolverTypesNotInSubsumptionRelation _ as e) -> - e.Output (os, canSuggestNames) + | ErrorFromAddingTypeEquation(error = ConstraintSolverTypesNotInSubsumptionRelation _ as e) -> e.Output(os, canSuggestNames) - | ErrorFromAddingTypeEquation (error = ConstraintSolverError _ as e) -> - e.Output (os, canSuggestNames) + | ErrorFromAddingTypeEquation(error = ConstraintSolverError _ as e) -> e.Output(os, canSuggestNames) | ErrorFromAddingTypeEquation (g, denv, ty1, ty2, e, _) -> if not (typeEquiv g ty1 ty2) then @@ -751,12 +743,12 @@ type Exception with if ty1 <> ty2 + tpcs then os.AppendString(ErrorFromAddingTypeEquation2E().Format ty1 ty2 tpcs) - e.Output (os, canSuggestNames) + e.Output(os, canSuggestNames) | ErrorFromApplyingDefault (_, denv, _, defaultType, e, _) -> let defaultType = NicePrint.minimalStringOfType denv defaultType os.AppendString(ErrorFromApplyingDefault1E().Format defaultType) - e.Output (os, canSuggestNames) + e.Output(os, canSuggestNames) os.AppendString(ErrorFromApplyingDefault2E().Format) | ErrorsFromAddingSubsumptionConstraint (g, denv, ty1, ty2, e, contextInfo, _) -> @@ -775,9 +767,9 @@ type Exception with if ty1 <> (ty2 + tpcs) then os.AppendString(ErrorsFromAddingSubsumptionConstraintE().Format ty2 ty1 tpcs) else - e.Output (os, canSuggestNames) + e.Output(os, canSuggestNames) else - e.Output (os, canSuggestNames) + e.Output(os, canSuggestNames) | UpperCaseIdentifierInPattern _ -> os.AppendString(UpperCaseIdentifierInPatternE().Format) @@ -785,12 +777,12 @@ type Exception with | NotUpperCaseConstructorWithoutRQA _ -> os.AppendString(NotUpperCaseConstructorWithoutRQAE().Format) - | ErrorFromAddingConstraint (_, e, _) -> e.Output (os, canSuggestNames) + | ErrorFromAddingConstraint (_, e, _) -> e.Output(os, canSuggestNames) #if !NO_TYPEPROVIDERS | TypeProviders.ProvidedTypeResolutionNoRange e - | TypeProviders.ProvidedTypeResolution (_, e) -> e.Output (os, canSuggestNames) + | TypeProviders.ProvidedTypeResolution (_, e) -> e.Output(os, canSuggestNames) | :? TypeProviderError as e -> os.AppendString(e.ContextualErrorMessage) #endif @@ -1017,7 +1009,7 @@ type Exception with let tokenIdToText tid = match tid with - | Parser.TOKEN_IDENT -> SR.GetString ("Parser.TOKEN.IDENT") + | Parser.TOKEN_IDENT -> SR.GetString("Parser.TOKEN.IDENT") | Parser.TOKEN_BIGNUM | Parser.TOKEN_INT8 | Parser.TOKEN_UINT8 @@ -1028,191 +1020,191 @@ type Exception with | Parser.TOKEN_INT64 | Parser.TOKEN_UINT64 | Parser.TOKEN_UNATIVEINT - | Parser.TOKEN_NATIVEINT -> SR.GetString ("Parser.TOKEN.INT") + | Parser.TOKEN_NATIVEINT -> SR.GetString("Parser.TOKEN.INT") | Parser.TOKEN_IEEE32 - | Parser.TOKEN_IEEE64 -> SR.GetString ("Parser.TOKEN.FLOAT") - | Parser.TOKEN_DECIMAL -> SR.GetString ("Parser.TOKEN.DECIMAL") - | Parser.TOKEN_CHAR -> SR.GetString ("Parser.TOKEN.CHAR") - - | Parser.TOKEN_BASE -> SR.GetString ("Parser.TOKEN.BASE") - | Parser.TOKEN_LPAREN_STAR_RPAREN -> SR.GetString ("Parser.TOKEN.LPAREN.STAR.RPAREN") - | Parser.TOKEN_DOLLAR -> SR.GetString ("Parser.TOKEN.DOLLAR") - | Parser.TOKEN_INFIX_STAR_STAR_OP -> SR.GetString ("Parser.TOKEN.INFIX.STAR.STAR.OP") - | Parser.TOKEN_INFIX_COMPARE_OP -> SR.GetString ("Parser.TOKEN.INFIX.COMPARE.OP") - | Parser.TOKEN_COLON_GREATER -> SR.GetString ("Parser.TOKEN.COLON.GREATER") - | Parser.TOKEN_COLON_COLON -> SR.GetString ("Parser.TOKEN.COLON.COLON") - | Parser.TOKEN_PERCENT_OP -> SR.GetString ("Parser.TOKEN.PERCENT.OP") - | Parser.TOKEN_INFIX_AT_HAT_OP -> SR.GetString ("Parser.TOKEN.INFIX.AT.HAT.OP") - | Parser.TOKEN_INFIX_BAR_OP -> SR.GetString ("Parser.TOKEN.INFIX.BAR.OP") - | Parser.TOKEN_PLUS_MINUS_OP -> SR.GetString ("Parser.TOKEN.PLUS.MINUS.OP") - | Parser.TOKEN_PREFIX_OP -> SR.GetString ("Parser.TOKEN.PREFIX.OP") - | Parser.TOKEN_COLON_QMARK_GREATER -> SR.GetString ("Parser.TOKEN.COLON.QMARK.GREATER") - | Parser.TOKEN_INFIX_STAR_DIV_MOD_OP -> SR.GetString ("Parser.TOKEN.INFIX.STAR.DIV.MOD.OP") - | Parser.TOKEN_INFIX_AMP_OP -> SR.GetString ("Parser.TOKEN.INFIX.AMP.OP") - | Parser.TOKEN_AMP -> SR.GetString ("Parser.TOKEN.AMP") - | Parser.TOKEN_AMP_AMP -> SR.GetString ("Parser.TOKEN.AMP.AMP") - | Parser.TOKEN_BAR_BAR -> SR.GetString ("Parser.TOKEN.BAR.BAR") - | Parser.TOKEN_LESS -> SR.GetString ("Parser.TOKEN.LESS") - | Parser.TOKEN_GREATER -> SR.GetString ("Parser.TOKEN.GREATER") - | Parser.TOKEN_QMARK -> SR.GetString ("Parser.TOKEN.QMARK") - | Parser.TOKEN_QMARK_QMARK -> SR.GetString ("Parser.TOKEN.QMARK.QMARK") - | Parser.TOKEN_COLON_QMARK -> SR.GetString ("Parser.TOKEN.COLON.QMARK") - | Parser.TOKEN_INT32_DOT_DOT -> SR.GetString ("Parser.TOKEN.INT32.DOT.DOT") - | Parser.TOKEN_DOT_DOT -> SR.GetString ("Parser.TOKEN.DOT.DOT") - | Parser.TOKEN_DOT_DOT_HAT -> SR.GetString ("Parser.TOKEN.DOT.DOT") - | Parser.TOKEN_QUOTE -> SR.GetString ("Parser.TOKEN.QUOTE") - | Parser.TOKEN_STAR -> SR.GetString ("Parser.TOKEN.STAR") - | Parser.TOKEN_HIGH_PRECEDENCE_TYAPP -> SR.GetString ("Parser.TOKEN.HIGH.PRECEDENCE.TYAPP") - | Parser.TOKEN_COLON -> SR.GetString ("Parser.TOKEN.COLON") - | Parser.TOKEN_COLON_EQUALS -> SR.GetString ("Parser.TOKEN.COLON.EQUALS") - | Parser.TOKEN_LARROW -> SR.GetString ("Parser.TOKEN.LARROW") - | Parser.TOKEN_EQUALS -> SR.GetString ("Parser.TOKEN.EQUALS") - | Parser.TOKEN_GREATER_BAR_RBRACK -> SR.GetString ("Parser.TOKEN.GREATER.BAR.RBRACK") - | Parser.TOKEN_MINUS -> SR.GetString ("Parser.TOKEN.MINUS") - | Parser.TOKEN_ADJACENT_PREFIX_OP -> SR.GetString ("Parser.TOKEN.ADJACENT.PREFIX.OP") - | Parser.TOKEN_FUNKY_OPERATOR_NAME -> SR.GetString ("Parser.TOKEN.FUNKY.OPERATOR.NAME") - | Parser.TOKEN_COMMA -> SR.GetString ("Parser.TOKEN.COMMA") - | Parser.TOKEN_DOT -> SR.GetString ("Parser.TOKEN.DOT") - | Parser.TOKEN_BAR -> SR.GetString ("Parser.TOKEN.BAR") - | Parser.TOKEN_HASH -> SR.GetString ("Parser.TOKEN.HASH") - | Parser.TOKEN_UNDERSCORE -> SR.GetString ("Parser.TOKEN.UNDERSCORE") - | Parser.TOKEN_SEMICOLON -> SR.GetString ("Parser.TOKEN.SEMICOLON") - | Parser.TOKEN_SEMICOLON_SEMICOLON -> SR.GetString ("Parser.TOKEN.SEMICOLON.SEMICOLON") - | Parser.TOKEN_LPAREN -> SR.GetString ("Parser.TOKEN.LPAREN") + | Parser.TOKEN_IEEE64 -> SR.GetString("Parser.TOKEN.FLOAT") + | Parser.TOKEN_DECIMAL -> SR.GetString("Parser.TOKEN.DECIMAL") + | Parser.TOKEN_CHAR -> SR.GetString("Parser.TOKEN.CHAR") + + | Parser.TOKEN_BASE -> SR.GetString("Parser.TOKEN.BASE") + | Parser.TOKEN_LPAREN_STAR_RPAREN -> SR.GetString("Parser.TOKEN.LPAREN.STAR.RPAREN") + | Parser.TOKEN_DOLLAR -> SR.GetString("Parser.TOKEN.DOLLAR") + | Parser.TOKEN_INFIX_STAR_STAR_OP -> SR.GetString("Parser.TOKEN.INFIX.STAR.STAR.OP") + | Parser.TOKEN_INFIX_COMPARE_OP -> SR.GetString("Parser.TOKEN.INFIX.COMPARE.OP") + | Parser.TOKEN_COLON_GREATER -> SR.GetString("Parser.TOKEN.COLON.GREATER") + | Parser.TOKEN_COLON_COLON -> SR.GetString("Parser.TOKEN.COLON.COLON") + | Parser.TOKEN_PERCENT_OP -> SR.GetString("Parser.TOKEN.PERCENT.OP") + | Parser.TOKEN_INFIX_AT_HAT_OP -> SR.GetString("Parser.TOKEN.INFIX.AT.HAT.OP") + | Parser.TOKEN_INFIX_BAR_OP -> SR.GetString("Parser.TOKEN.INFIX.BAR.OP") + | Parser.TOKEN_PLUS_MINUS_OP -> SR.GetString("Parser.TOKEN.PLUS.MINUS.OP") + | Parser.TOKEN_PREFIX_OP -> SR.GetString("Parser.TOKEN.PREFIX.OP") + | Parser.TOKEN_COLON_QMARK_GREATER -> SR.GetString("Parser.TOKEN.COLON.QMARK.GREATER") + | Parser.TOKEN_INFIX_STAR_DIV_MOD_OP -> SR.GetString("Parser.TOKEN.INFIX.STAR.DIV.MOD.OP") + | Parser.TOKEN_INFIX_AMP_OP -> SR.GetString("Parser.TOKEN.INFIX.AMP.OP") + | Parser.TOKEN_AMP -> SR.GetString("Parser.TOKEN.AMP") + | Parser.TOKEN_AMP_AMP -> SR.GetString("Parser.TOKEN.AMP.AMP") + | Parser.TOKEN_BAR_BAR -> SR.GetString("Parser.TOKEN.BAR.BAR") + | Parser.TOKEN_LESS -> SR.GetString("Parser.TOKEN.LESS") + | Parser.TOKEN_GREATER -> SR.GetString("Parser.TOKEN.GREATER") + | Parser.TOKEN_QMARK -> SR.GetString("Parser.TOKEN.QMARK") + | Parser.TOKEN_QMARK_QMARK -> SR.GetString("Parser.TOKEN.QMARK.QMARK") + | Parser.TOKEN_COLON_QMARK -> SR.GetString("Parser.TOKEN.COLON.QMARK") + | Parser.TOKEN_INT32_DOT_DOT -> SR.GetString("Parser.TOKEN.INT32.DOT.DOT") + | Parser.TOKEN_DOT_DOT -> SR.GetString("Parser.TOKEN.DOT.DOT") + | Parser.TOKEN_DOT_DOT_HAT -> SR.GetString("Parser.TOKEN.DOT.DOT") + | Parser.TOKEN_QUOTE -> SR.GetString("Parser.TOKEN.QUOTE") + | Parser.TOKEN_STAR -> SR.GetString("Parser.TOKEN.STAR") + | Parser.TOKEN_HIGH_PRECEDENCE_TYAPP -> SR.GetString("Parser.TOKEN.HIGH.PRECEDENCE.TYAPP") + | Parser.TOKEN_COLON -> SR.GetString("Parser.TOKEN.COLON") + | Parser.TOKEN_COLON_EQUALS -> SR.GetString("Parser.TOKEN.COLON.EQUALS") + | Parser.TOKEN_LARROW -> SR.GetString("Parser.TOKEN.LARROW") + | Parser.TOKEN_EQUALS -> SR.GetString("Parser.TOKEN.EQUALS") + | Parser.TOKEN_GREATER_BAR_RBRACK -> SR.GetString("Parser.TOKEN.GREATER.BAR.RBRACK") + | Parser.TOKEN_MINUS -> SR.GetString("Parser.TOKEN.MINUS") + | Parser.TOKEN_ADJACENT_PREFIX_OP -> SR.GetString("Parser.TOKEN.ADJACENT.PREFIX.OP") + | Parser.TOKEN_FUNKY_OPERATOR_NAME -> SR.GetString("Parser.TOKEN.FUNKY.OPERATOR.NAME") + | Parser.TOKEN_COMMA -> SR.GetString("Parser.TOKEN.COMMA") + | Parser.TOKEN_DOT -> SR.GetString("Parser.TOKEN.DOT") + | Parser.TOKEN_BAR -> SR.GetString("Parser.TOKEN.BAR") + | Parser.TOKEN_HASH -> SR.GetString("Parser.TOKEN.HASH") + | Parser.TOKEN_UNDERSCORE -> SR.GetString("Parser.TOKEN.UNDERSCORE") + | Parser.TOKEN_SEMICOLON -> SR.GetString("Parser.TOKEN.SEMICOLON") + | Parser.TOKEN_SEMICOLON_SEMICOLON -> SR.GetString("Parser.TOKEN.SEMICOLON.SEMICOLON") + | Parser.TOKEN_LPAREN -> SR.GetString("Parser.TOKEN.LPAREN") | Parser.TOKEN_RPAREN | Parser.TOKEN_RPAREN_COMING_SOON - | Parser.TOKEN_RPAREN_IS_HERE -> SR.GetString ("Parser.TOKEN.RPAREN") - | Parser.TOKEN_LQUOTE -> SR.GetString ("Parser.TOKEN.LQUOTE") - | Parser.TOKEN_LBRACK -> SR.GetString ("Parser.TOKEN.LBRACK") - | Parser.TOKEN_LBRACE_BAR -> SR.GetString ("Parser.TOKEN.LBRACE.BAR") - | Parser.TOKEN_LBRACK_BAR -> SR.GetString ("Parser.TOKEN.LBRACK.BAR") - | Parser.TOKEN_LBRACK_LESS -> SR.GetString ("Parser.TOKEN.LBRACK.LESS") - | Parser.TOKEN_LBRACE -> SR.GetString ("Parser.TOKEN.LBRACE") - | Parser.TOKEN_BAR_RBRACK -> SR.GetString ("Parser.TOKEN.BAR.RBRACK") - | Parser.TOKEN_BAR_RBRACE -> SR.GetString ("Parser.TOKEN.BAR.RBRACE") - | Parser.TOKEN_GREATER_RBRACK -> SR.GetString ("Parser.TOKEN.GREATER.RBRACK") + | Parser.TOKEN_RPAREN_IS_HERE -> SR.GetString("Parser.TOKEN.RPAREN") + | Parser.TOKEN_LQUOTE -> SR.GetString("Parser.TOKEN.LQUOTE") + | Parser.TOKEN_LBRACK -> SR.GetString("Parser.TOKEN.LBRACK") + | Parser.TOKEN_LBRACE_BAR -> SR.GetString("Parser.TOKEN.LBRACE.BAR") + | Parser.TOKEN_LBRACK_BAR -> SR.GetString("Parser.TOKEN.LBRACK.BAR") + | Parser.TOKEN_LBRACK_LESS -> SR.GetString("Parser.TOKEN.LBRACK.LESS") + | Parser.TOKEN_LBRACE -> SR.GetString("Parser.TOKEN.LBRACE") + | Parser.TOKEN_BAR_RBRACK -> SR.GetString("Parser.TOKEN.BAR.RBRACK") + | Parser.TOKEN_BAR_RBRACE -> SR.GetString("Parser.TOKEN.BAR.RBRACE") + | Parser.TOKEN_GREATER_RBRACK -> SR.GetString("Parser.TOKEN.GREATER.RBRACK") | Parser.TOKEN_RQUOTE_DOT _ - | Parser.TOKEN_RQUOTE -> SR.GetString ("Parser.TOKEN.RQUOTE") - | Parser.TOKEN_RBRACK -> SR.GetString ("Parser.TOKEN.RBRACK") + | Parser.TOKEN_RQUOTE -> SR.GetString("Parser.TOKEN.RQUOTE") + | Parser.TOKEN_RBRACK -> SR.GetString("Parser.TOKEN.RBRACK") | Parser.TOKEN_RBRACE | Parser.TOKEN_RBRACE_COMING_SOON - | Parser.TOKEN_RBRACE_IS_HERE -> SR.GetString ("Parser.TOKEN.RBRACE") - | Parser.TOKEN_PUBLIC -> SR.GetString ("Parser.TOKEN.PUBLIC") - | Parser.TOKEN_PRIVATE -> SR.GetString ("Parser.TOKEN.PRIVATE") - | Parser.TOKEN_INTERNAL -> SR.GetString ("Parser.TOKEN.INTERNAL") - | Parser.TOKEN_CONSTRAINT -> SR.GetString ("Parser.TOKEN.CONSTRAINT") - | Parser.TOKEN_INSTANCE -> SR.GetString ("Parser.TOKEN.INSTANCE") - | Parser.TOKEN_DELEGATE -> SR.GetString ("Parser.TOKEN.DELEGATE") - | Parser.TOKEN_INHERIT -> SR.GetString ("Parser.TOKEN.INHERIT") - | Parser.TOKEN_CONSTRUCTOR -> SR.GetString ("Parser.TOKEN.CONSTRUCTOR") - | Parser.TOKEN_DEFAULT -> SR.GetString ("Parser.TOKEN.DEFAULT") - | Parser.TOKEN_OVERRIDE -> SR.GetString ("Parser.TOKEN.OVERRIDE") - | Parser.TOKEN_ABSTRACT -> SR.GetString ("Parser.TOKEN.ABSTRACT") - | Parser.TOKEN_CLASS -> SR.GetString ("Parser.TOKEN.CLASS") - | Parser.TOKEN_MEMBER -> SR.GetString ("Parser.TOKEN.MEMBER") - | Parser.TOKEN_STATIC -> SR.GetString ("Parser.TOKEN.STATIC") - | Parser.TOKEN_NAMESPACE -> SR.GetString ("Parser.TOKEN.NAMESPACE") - | Parser.TOKEN_OBLOCKBEGIN -> SR.GetString ("Parser.TOKEN.OBLOCKBEGIN") - | EndOfStructuredConstructToken -> SR.GetString ("Parser.TOKEN.OBLOCKEND") + | Parser.TOKEN_RBRACE_IS_HERE -> SR.GetString("Parser.TOKEN.RBRACE") + | Parser.TOKEN_PUBLIC -> SR.GetString("Parser.TOKEN.PUBLIC") + | Parser.TOKEN_PRIVATE -> SR.GetString("Parser.TOKEN.PRIVATE") + | Parser.TOKEN_INTERNAL -> SR.GetString("Parser.TOKEN.INTERNAL") + | Parser.TOKEN_CONSTRAINT -> SR.GetString("Parser.TOKEN.CONSTRAINT") + | Parser.TOKEN_INSTANCE -> SR.GetString("Parser.TOKEN.INSTANCE") + | Parser.TOKEN_DELEGATE -> SR.GetString("Parser.TOKEN.DELEGATE") + | Parser.TOKEN_INHERIT -> SR.GetString("Parser.TOKEN.INHERIT") + | Parser.TOKEN_CONSTRUCTOR -> SR.GetString("Parser.TOKEN.CONSTRUCTOR") + | Parser.TOKEN_DEFAULT -> SR.GetString("Parser.TOKEN.DEFAULT") + | Parser.TOKEN_OVERRIDE -> SR.GetString("Parser.TOKEN.OVERRIDE") + | Parser.TOKEN_ABSTRACT -> SR.GetString("Parser.TOKEN.ABSTRACT") + | Parser.TOKEN_CLASS -> SR.GetString("Parser.TOKEN.CLASS") + | Parser.TOKEN_MEMBER -> SR.GetString("Parser.TOKEN.MEMBER") + | Parser.TOKEN_STATIC -> SR.GetString("Parser.TOKEN.STATIC") + | Parser.TOKEN_NAMESPACE -> SR.GetString("Parser.TOKEN.NAMESPACE") + | Parser.TOKEN_OBLOCKBEGIN -> SR.GetString("Parser.TOKEN.OBLOCKBEGIN") + | EndOfStructuredConstructToken -> SR.GetString("Parser.TOKEN.OBLOCKEND") | Parser.TOKEN_THEN - | Parser.TOKEN_OTHEN -> SR.GetString ("Parser.TOKEN.OTHEN") + | Parser.TOKEN_OTHEN -> SR.GetString("Parser.TOKEN.OTHEN") | Parser.TOKEN_ELSE - | Parser.TOKEN_OELSE -> SR.GetString ("Parser.TOKEN.OELSE") + | Parser.TOKEN_OELSE -> SR.GetString("Parser.TOKEN.OELSE") | Parser.TOKEN_LET _ - | Parser.TOKEN_OLET _ -> SR.GetString ("Parser.TOKEN.OLET") + | Parser.TOKEN_OLET _ -> SR.GetString("Parser.TOKEN.OLET") | Parser.TOKEN_OBINDER - | Parser.TOKEN_BINDER -> SR.GetString ("Parser.TOKEN.BINDER") + | Parser.TOKEN_BINDER -> SR.GetString("Parser.TOKEN.BINDER") | Parser.TOKEN_OAND_BANG - | Parser.TOKEN_AND_BANG -> SR.GetString ("Parser.TOKEN.AND.BANG") - | Parser.TOKEN_ODO -> SR.GetString ("Parser.TOKEN.ODO") - | Parser.TOKEN_OWITH -> SR.GetString ("Parser.TOKEN.OWITH") - | Parser.TOKEN_OFUNCTION -> SR.GetString ("Parser.TOKEN.OFUNCTION") - | Parser.TOKEN_OFUN -> SR.GetString ("Parser.TOKEN.OFUN") - | Parser.TOKEN_ORESET -> SR.GetString ("Parser.TOKEN.ORESET") - | Parser.TOKEN_ODUMMY -> SR.GetString ("Parser.TOKEN.ODUMMY") + | Parser.TOKEN_AND_BANG -> SR.GetString("Parser.TOKEN.AND.BANG") + | Parser.TOKEN_ODO -> SR.GetString("Parser.TOKEN.ODO") + | Parser.TOKEN_OWITH -> SR.GetString("Parser.TOKEN.OWITH") + | Parser.TOKEN_OFUNCTION -> SR.GetString("Parser.TOKEN.OFUNCTION") + | Parser.TOKEN_OFUN -> SR.GetString("Parser.TOKEN.OFUN") + | Parser.TOKEN_ORESET -> SR.GetString("Parser.TOKEN.ORESET") + | Parser.TOKEN_ODUMMY -> SR.GetString("Parser.TOKEN.ODUMMY") | Parser.TOKEN_DO_BANG - | Parser.TOKEN_ODO_BANG -> SR.GetString ("Parser.TOKEN.ODO.BANG") - | Parser.TOKEN_YIELD -> SR.GetString ("Parser.TOKEN.YIELD") - | Parser.TOKEN_YIELD_BANG -> SR.GetString ("Parser.TOKEN.YIELD.BANG") - | Parser.TOKEN_OINTERFACE_MEMBER -> SR.GetString ("Parser.TOKEN.OINTERFACE.MEMBER") - | Parser.TOKEN_ELIF -> SR.GetString ("Parser.TOKEN.ELIF") - | Parser.TOKEN_RARROW -> SR.GetString ("Parser.TOKEN.RARROW") - | Parser.TOKEN_SIG -> SR.GetString ("Parser.TOKEN.SIG") - | Parser.TOKEN_STRUCT -> SR.GetString ("Parser.TOKEN.STRUCT") - | Parser.TOKEN_UPCAST -> SR.GetString ("Parser.TOKEN.UPCAST") - | Parser.TOKEN_DOWNCAST -> SR.GetString ("Parser.TOKEN.DOWNCAST") - | Parser.TOKEN_NULL -> SR.GetString ("Parser.TOKEN.NULL") - | Parser.TOKEN_RESERVED -> SR.GetString ("Parser.TOKEN.RESERVED") + | Parser.TOKEN_ODO_BANG -> SR.GetString("Parser.TOKEN.ODO.BANG") + | Parser.TOKEN_YIELD -> SR.GetString("Parser.TOKEN.YIELD") + | Parser.TOKEN_YIELD_BANG -> SR.GetString("Parser.TOKEN.YIELD.BANG") + | Parser.TOKEN_OINTERFACE_MEMBER -> SR.GetString("Parser.TOKEN.OINTERFACE.MEMBER") + | Parser.TOKEN_ELIF -> SR.GetString("Parser.TOKEN.ELIF") + | Parser.TOKEN_RARROW -> SR.GetString("Parser.TOKEN.RARROW") + | Parser.TOKEN_SIG -> SR.GetString("Parser.TOKEN.SIG") + | Parser.TOKEN_STRUCT -> SR.GetString("Parser.TOKEN.STRUCT") + | Parser.TOKEN_UPCAST -> SR.GetString("Parser.TOKEN.UPCAST") + | Parser.TOKEN_DOWNCAST -> SR.GetString("Parser.TOKEN.DOWNCAST") + | Parser.TOKEN_NULL -> SR.GetString("Parser.TOKEN.NULL") + | Parser.TOKEN_RESERVED -> SR.GetString("Parser.TOKEN.RESERVED") | Parser.TOKEN_MODULE | Parser.TOKEN_MODULE_COMING_SOON - | Parser.TOKEN_MODULE_IS_HERE -> SR.GetString ("Parser.TOKEN.MODULE") - | Parser.TOKEN_AND -> SR.GetString ("Parser.TOKEN.AND") - | Parser.TOKEN_AS -> SR.GetString ("Parser.TOKEN.AS") - | Parser.TOKEN_ASSERT -> SR.GetString ("Parser.TOKEN.ASSERT") - | Parser.TOKEN_OASSERT -> SR.GetString ("Parser.TOKEN.ASSERT") - | Parser.TOKEN_ASR -> SR.GetString ("Parser.TOKEN.ASR") - | Parser.TOKEN_DOWNTO -> SR.GetString ("Parser.TOKEN.DOWNTO") - | Parser.TOKEN_EXCEPTION -> SR.GetString ("Parser.TOKEN.EXCEPTION") - | Parser.TOKEN_FALSE -> SR.GetString ("Parser.TOKEN.FALSE") - | Parser.TOKEN_FOR -> SR.GetString ("Parser.TOKEN.FOR") - | Parser.TOKEN_FUN -> SR.GetString ("Parser.TOKEN.FUN") - | Parser.TOKEN_FUNCTION -> SR.GetString ("Parser.TOKEN.FUNCTION") - | Parser.TOKEN_FINALLY -> SR.GetString ("Parser.TOKEN.FINALLY") - | Parser.TOKEN_LAZY -> SR.GetString ("Parser.TOKEN.LAZY") - | Parser.TOKEN_OLAZY -> SR.GetString ("Parser.TOKEN.LAZY") - | Parser.TOKEN_MATCH -> SR.GetString ("Parser.TOKEN.MATCH") - | Parser.TOKEN_MATCH_BANG -> SR.GetString ("Parser.TOKEN.MATCH.BANG") - | Parser.TOKEN_MUTABLE -> SR.GetString ("Parser.TOKEN.MUTABLE") - | Parser.TOKEN_NEW -> SR.GetString ("Parser.TOKEN.NEW") - | Parser.TOKEN_OF -> SR.GetString ("Parser.TOKEN.OF") - | Parser.TOKEN_OPEN -> SR.GetString ("Parser.TOKEN.OPEN") - | Parser.TOKEN_OR -> SR.GetString ("Parser.TOKEN.OR") - | Parser.TOKEN_VOID -> SR.GetString ("Parser.TOKEN.VOID") - | Parser.TOKEN_EXTERN -> SR.GetString ("Parser.TOKEN.EXTERN") - | Parser.TOKEN_INTERFACE -> SR.GetString ("Parser.TOKEN.INTERFACE") - | Parser.TOKEN_REC -> SR.GetString ("Parser.TOKEN.REC") - | Parser.TOKEN_TO -> SR.GetString ("Parser.TOKEN.TO") - | Parser.TOKEN_TRUE -> SR.GetString ("Parser.TOKEN.TRUE") - | Parser.TOKEN_TRY -> SR.GetString ("Parser.TOKEN.TRY") + | Parser.TOKEN_MODULE_IS_HERE -> SR.GetString("Parser.TOKEN.MODULE") + | Parser.TOKEN_AND -> SR.GetString("Parser.TOKEN.AND") + | Parser.TOKEN_AS -> SR.GetString("Parser.TOKEN.AS") + | Parser.TOKEN_ASSERT -> SR.GetString("Parser.TOKEN.ASSERT") + | Parser.TOKEN_OASSERT -> SR.GetString("Parser.TOKEN.ASSERT") + | Parser.TOKEN_ASR -> SR.GetString("Parser.TOKEN.ASR") + | Parser.TOKEN_DOWNTO -> SR.GetString("Parser.TOKEN.DOWNTO") + | Parser.TOKEN_EXCEPTION -> SR.GetString("Parser.TOKEN.EXCEPTION") + | Parser.TOKEN_FALSE -> SR.GetString("Parser.TOKEN.FALSE") + | Parser.TOKEN_FOR -> SR.GetString("Parser.TOKEN.FOR") + | Parser.TOKEN_FUN -> SR.GetString("Parser.TOKEN.FUN") + | Parser.TOKEN_FUNCTION -> SR.GetString("Parser.TOKEN.FUNCTION") + | Parser.TOKEN_FINALLY -> SR.GetString("Parser.TOKEN.FINALLY") + | Parser.TOKEN_LAZY -> SR.GetString("Parser.TOKEN.LAZY") + | Parser.TOKEN_OLAZY -> SR.GetString("Parser.TOKEN.LAZY") + | Parser.TOKEN_MATCH -> SR.GetString("Parser.TOKEN.MATCH") + | Parser.TOKEN_MATCH_BANG -> SR.GetString("Parser.TOKEN.MATCH.BANG") + | Parser.TOKEN_MUTABLE -> SR.GetString("Parser.TOKEN.MUTABLE") + | Parser.TOKEN_NEW -> SR.GetString("Parser.TOKEN.NEW") + | Parser.TOKEN_OF -> SR.GetString("Parser.TOKEN.OF") + | Parser.TOKEN_OPEN -> SR.GetString("Parser.TOKEN.OPEN") + | Parser.TOKEN_OR -> SR.GetString("Parser.TOKEN.OR") + | Parser.TOKEN_VOID -> SR.GetString("Parser.TOKEN.VOID") + | Parser.TOKEN_EXTERN -> SR.GetString("Parser.TOKEN.EXTERN") + | Parser.TOKEN_INTERFACE -> SR.GetString("Parser.TOKEN.INTERFACE") + | Parser.TOKEN_REC -> SR.GetString("Parser.TOKEN.REC") + | Parser.TOKEN_TO -> SR.GetString("Parser.TOKEN.TO") + | Parser.TOKEN_TRUE -> SR.GetString("Parser.TOKEN.TRUE") + | Parser.TOKEN_TRY -> SR.GetString("Parser.TOKEN.TRY") | Parser.TOKEN_TYPE | Parser.TOKEN_TYPE_COMING_SOON - | Parser.TOKEN_TYPE_IS_HERE -> SR.GetString ("Parser.TOKEN.TYPE") - | Parser.TOKEN_VAL -> SR.GetString ("Parser.TOKEN.VAL") - | Parser.TOKEN_INLINE -> SR.GetString ("Parser.TOKEN.INLINE") - | Parser.TOKEN_WHEN -> SR.GetString ("Parser.TOKEN.WHEN") - | Parser.TOKEN_WHILE -> SR.GetString ("Parser.TOKEN.WHILE") - | Parser.TOKEN_WITH -> SR.GetString ("Parser.TOKEN.WITH") - | Parser.TOKEN_IF -> SR.GetString ("Parser.TOKEN.IF") - | Parser.TOKEN_DO -> SR.GetString ("Parser.TOKEN.DO") - | Parser.TOKEN_GLOBAL -> SR.GetString ("Parser.TOKEN.GLOBAL") - | Parser.TOKEN_DONE -> SR.GetString ("Parser.TOKEN.DONE") + | Parser.TOKEN_TYPE_IS_HERE -> SR.GetString("Parser.TOKEN.TYPE") + | Parser.TOKEN_VAL -> SR.GetString("Parser.TOKEN.VAL") + | Parser.TOKEN_INLINE -> SR.GetString("Parser.TOKEN.INLINE") + | Parser.TOKEN_WHEN -> SR.GetString("Parser.TOKEN.WHEN") + | Parser.TOKEN_WHILE -> SR.GetString("Parser.TOKEN.WHILE") + | Parser.TOKEN_WITH -> SR.GetString("Parser.TOKEN.WITH") + | Parser.TOKEN_IF -> SR.GetString("Parser.TOKEN.IF") + | Parser.TOKEN_DO -> SR.GetString("Parser.TOKEN.DO") + | Parser.TOKEN_GLOBAL -> SR.GetString("Parser.TOKEN.GLOBAL") + | Parser.TOKEN_DONE -> SR.GetString("Parser.TOKEN.DONE") | Parser.TOKEN_IN - | Parser.TOKEN_JOIN_IN -> SR.GetString ("Parser.TOKEN.IN") - | Parser.TOKEN_HIGH_PRECEDENCE_PAREN_APP -> SR.GetString ("Parser.TOKEN.HIGH.PRECEDENCE.PAREN.APP") - | Parser.TOKEN_HIGH_PRECEDENCE_BRACK_APP -> SR.GetString ("Parser.TOKEN.HIGH.PRECEDENCE.BRACK.APP") - | Parser.TOKEN_BEGIN -> SR.GetString ("Parser.TOKEN.BEGIN") - | Parser.TOKEN_END -> SR.GetString ("Parser.TOKEN.END") + | Parser.TOKEN_JOIN_IN -> SR.GetString("Parser.TOKEN.IN") + | Parser.TOKEN_HIGH_PRECEDENCE_PAREN_APP -> SR.GetString("Parser.TOKEN.HIGH.PRECEDENCE.PAREN.APP") + | Parser.TOKEN_HIGH_PRECEDENCE_BRACK_APP -> SR.GetString("Parser.TOKEN.HIGH.PRECEDENCE.BRACK.APP") + | Parser.TOKEN_BEGIN -> SR.GetString("Parser.TOKEN.BEGIN") + | Parser.TOKEN_END -> SR.GetString("Parser.TOKEN.END") | Parser.TOKEN_HASH_LIGHT | Parser.TOKEN_HASH_LINE | Parser.TOKEN_HASH_IF | Parser.TOKEN_HASH_ELSE - | Parser.TOKEN_HASH_ENDIF -> SR.GetString ("Parser.TOKEN.HASH.ENDIF") - | Parser.TOKEN_INACTIVECODE -> SR.GetString ("Parser.TOKEN.INACTIVECODE") - | Parser.TOKEN_LEX_FAILURE -> SR.GetString ("Parser.TOKEN.LEX.FAILURE") - | Parser.TOKEN_WHITESPACE -> SR.GetString ("Parser.TOKEN.WHITESPACE") - | Parser.TOKEN_COMMENT -> SR.GetString ("Parser.TOKEN.COMMENT") - | Parser.TOKEN_LINE_COMMENT -> SR.GetString ("Parser.TOKEN.LINE.COMMENT") - | Parser.TOKEN_STRING_TEXT -> SR.GetString ("Parser.TOKEN.STRING.TEXT") - | Parser.TOKEN_BYTEARRAY -> SR.GetString ("Parser.TOKEN.BYTEARRAY") - | Parser.TOKEN_STRING -> SR.GetString ("Parser.TOKEN.STRING") - | Parser.TOKEN_KEYWORD_STRING -> SR.GetString ("Parser.TOKEN.KEYWORD_STRING") - | Parser.TOKEN_EOF -> SR.GetString ("Parser.TOKEN.EOF") - | Parser.TOKEN_CONST -> SR.GetString ("Parser.TOKEN.CONST") - | Parser.TOKEN_FIXED -> SR.GetString ("Parser.TOKEN.FIXED") - | Parser.TOKEN_INTERP_STRING_BEGIN_END -> SR.GetString ("Parser.TOKEN.INTERP.STRING.BEGIN.END") - | Parser.TOKEN_INTERP_STRING_BEGIN_PART -> SR.GetString ("Parser.TOKEN.INTERP.STRING.BEGIN.PART") - | Parser.TOKEN_INTERP_STRING_PART -> SR.GetString ("Parser.TOKEN.INTERP.STRING.PART") - | Parser.TOKEN_INTERP_STRING_END -> SR.GetString ("Parser.TOKEN.INTERP.STRING.END") + | Parser.TOKEN_HASH_ENDIF -> SR.GetString("Parser.TOKEN.HASH.ENDIF") + | Parser.TOKEN_INACTIVECODE -> SR.GetString("Parser.TOKEN.INACTIVECODE") + | Parser.TOKEN_LEX_FAILURE -> SR.GetString("Parser.TOKEN.LEX.FAILURE") + | Parser.TOKEN_WHITESPACE -> SR.GetString("Parser.TOKEN.WHITESPACE") + | Parser.TOKEN_COMMENT -> SR.GetString("Parser.TOKEN.COMMENT") + | Parser.TOKEN_LINE_COMMENT -> SR.GetString("Parser.TOKEN.LINE.COMMENT") + | Parser.TOKEN_STRING_TEXT -> SR.GetString("Parser.TOKEN.STRING.TEXT") + | Parser.TOKEN_BYTEARRAY -> SR.GetString("Parser.TOKEN.BYTEARRAY") + | Parser.TOKEN_STRING -> SR.GetString("Parser.TOKEN.STRING") + | Parser.TOKEN_KEYWORD_STRING -> SR.GetString("Parser.TOKEN.KEYWORD_STRING") + | Parser.TOKEN_EOF -> SR.GetString("Parser.TOKEN.EOF") + | Parser.TOKEN_CONST -> SR.GetString("Parser.TOKEN.CONST") + | Parser.TOKEN_FIXED -> SR.GetString("Parser.TOKEN.FIXED") + | Parser.TOKEN_INTERP_STRING_BEGIN_END -> SR.GetString("Parser.TOKEN.INTERP.STRING.BEGIN.END") + | Parser.TOKEN_INTERP_STRING_BEGIN_PART -> SR.GetString("Parser.TOKEN.INTERP.STRING.BEGIN.PART") + | Parser.TOKEN_INTERP_STRING_PART -> SR.GetString("Parser.TOKEN.INTERP.STRING.PART") + | Parser.TOKEN_INTERP_STRING_END -> SR.GetString("Parser.TOKEN.INTERP.STRING.END") | unknown -> Debug.Assert(false, "unknown token tag") let result = sprintf "%+A" unknown @@ -1677,8 +1669,7 @@ type Exception with Debug.Assert(false, sprintf "Unexpected exception seen in compiler: %s\n%s" s (exn.ToString())) #endif - | WrappedError (e, _) -> - e.Output (os, canSuggestNames) + | WrappedError (e, _) -> e.Output(os, canSuggestNames) | PatternMatchCompilation.MatchIncomplete (isComp, cexOpt, _) -> os.AppendString(MatchIncomplete1E().Format) @@ -1835,15 +1826,15 @@ type Exception with | HashLoadedSourceHasIssues (infos, warnings, errors, _) -> match warnings, errors with - | _, e::_ -> + | _, e :: _ -> os.AppendString(HashLoadedSourceHasIssues2E().Format) - e.Output (os, canSuggestNames) - | e::_, _ -> + e.Output(os, canSuggestNames) + | e :: _, _ -> os.AppendString(HashLoadedSourceHasIssues1E().Format) - e.Output (os, canSuggestNames) - | [], [] -> + e.Output(os, canSuggestNames) + | [], [] -> os.AppendString(HashLoadedSourceHasIssues0E().Format) - infos.Head.Output (os, canSuggestNames) + infos.Head.Output(os, canSuggestNames) | HashLoadedScriptConsideredSource _ -> os.AppendString(HashLoadedScriptConsideredSourceE().Format) @@ -1859,8 +1850,7 @@ type Exception with | MSBuildReferenceResolutionError (code, message, _) -> os.AppendString(MSBuildReferenceResolutionErrorE().Format message code) // Strip TargetInvocationException wrappers - | :? TargetInvocationException as exn -> - exn.InnerException.Output (os, canSuggestNames) + | :? TargetInvocationException as exn -> exn.InnerException.Output(os, canSuggestNames) | :? FileNotFoundException as exn -> Printf.bprintf os "%s" exn.Message @@ -1887,7 +1877,7 @@ type Exception with type PhasedDiagnostic with // remove any newlines and tabs - member x.OutputCore (os: StringBuilder, flattenErrors: bool, suggestNames: bool) = + member x.OutputCore(os: StringBuilder, flattenErrors: bool, suggestNames: bool) = let buf = StringBuilder() x.Exception.Output(buf, suggestNames) @@ -1900,15 +1890,15 @@ type PhasedDiagnostic with os.AppendString text - member x.FormatCore (flattenErrors: bool, suggestNames: bool) = + member x.FormatCore(flattenErrors: bool, suggestNames: bool) = let os = StringBuilder() x.OutputCore(os, flattenErrors, suggestNames) os.ToString() - member x.EagerlyFormatCore (flattenErrors: bool, suggestNames: bool) = + member x.EagerlyFormatCore(flattenErrors: bool, suggestNames: bool) = match x.Range with | Some m -> - let message = x.FormatCore (flattenErrors, suggestNames) + let message = x.FormatCore(flattenErrors, suggestNames) let exn = DiagnosticWithText(x.Number, message, m) { Exception = exn; Phase = x.Phase } | None -> x @@ -2034,13 +2024,7 @@ let FormatDiagnosticLocation (tcConfig: TcConfig) m : FormattedDiagnosticLocatio } /// returns sequence that contains Diagnostic for the given error + Diagnostic for all related errors -let CollectFormattedDiagnostics - ( - tcConfig: TcConfig, - severity: FSharpDiagnosticSeverity, - diagnostic: PhasedDiagnostic, - suggestNames: bool - ) = +let CollectFormattedDiagnostics (tcConfig: TcConfig, severity: FSharpDiagnosticSeverity, diagnostic: PhasedDiagnostic, suggestNames: bool) = match diagnostic.Exception with | ReportedError _ -> @@ -2052,16 +2036,15 @@ let CollectFormattedDiagnostics | _ -> let errors = ResizeArray() - let report (diagnostic: PhasedDiagnostic) = + let report (diagnostic: PhasedDiagnostic) = let where = match diagnostic.Range with - | Some m -> - FormatDiagnosticLocation tcConfig m - |> Some + | Some m -> FormatDiagnosticLocation tcConfig m |> Some | None -> None let subcategory = diagnostic.Subcategory() let errorNumber = diagnostic.Number + let message = match severity with | FSharpDiagnosticSeverity.Error -> "error" @@ -2075,14 +2058,14 @@ let CollectFormattedDiagnostics | DiagnosticStyle.VisualStudio -> sprintf "%s %s FS%04d: " subcategory message errorNumber | _ -> sprintf "%s FS%04d: " message errorNumber - let canonical : FormattedDiagnosticCanonicalInformation = + let canonical: FormattedDiagnosticCanonicalInformation = { ErrorNumber = errorNumber Subcategory = subcategory TextRepresentation = text } - let message = diagnostic.FormatCore (tcConfig.flatErrors, suggestNames) + let message = diagnostic.FormatCore(tcConfig.flatErrors, suggestNames) let entry: FormattedDiagnosticDetailedInfo = { @@ -2095,8 +2078,7 @@ let CollectFormattedDiagnostics match diagnostic.Exception with #if !NO_TYPEPROVIDERS - | :? TypeProviderError as tpe -> - tpe.Iter(fun exn -> report { diagnostic with Exception = exn }) + | :? TypeProviderError as tpe -> tpe.Iter(fun exn -> report { diagnostic with Exception = exn }) #endif | _ -> report diagnostic @@ -2106,11 +2088,10 @@ type PhasedDiagnostic with /// used by fsc.exe and fsi.exe, but not by VS /// prints error and related errors to the specified StringBuilder - member diagnostic.Output (buf, tcConfig: TcConfig, severity) = + member diagnostic.Output(buf, tcConfig: TcConfig, severity) = // '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 diagnostics = - CollectFormattedDiagnostics(tcConfig, severity, diagnostic, true) + let diagnostics = CollectFormattedDiagnostics(tcConfig, severity, diagnostic, true) for e in diagnostics do Printf.bprintf buf "\n" @@ -2125,7 +2106,7 @@ type PhasedDiagnostic with buf.AppendString details.Canonical.TextRepresentation buf.AppendString details.Message - member diagnostic.OutputContext (buf, prefix, fileLineFunction) = + member diagnostic.OutputContext(buf, prefix, fileLineFunction) = match diagnostic.Range with | None -> () | Some m -> @@ -2141,11 +2122,10 @@ type PhasedDiagnostic with Printf.bprintf buf "%s%s\n" prefix line Printf.bprintf buf "%s%s%s\n" prefix (String.make iA '-') (String.make iLen '^') - member diagnostic.WriteWithContext (os, prefix, fileLineFunction, tcConfig, severity) = + member diagnostic.WriteWithContext(os, prefix, fileLineFunction, tcConfig, severity) = writeViaBuffer os (fun buf -> - diagnostic.OutputContext (buf, prefix, fileLineFunction) - diagnostic.Output (buf, tcConfig, severity) - ) + diagnostic.OutputContext(buf, prefix, fileLineFunction) + diagnostic.Output(buf, tcConfig, severity)) //---------------------------------------------------------------------------- // Scoped #nowarn pragmas @@ -2187,11 +2167,11 @@ type DiagnosticsLoggerFilteringByScopedPragmas | None -> true if report then - if diagnostic.ReportAsError (diagnosticOptions, severity) then + if diagnostic.ReportAsError(diagnosticOptions, severity) then diagnosticsLogger.DiagnosticSink(diagnostic, FSharpDiagnosticSeverity.Error) - elif diagnostic.ReportAsWarning (diagnosticOptions, severity) then + elif diagnostic.ReportAsWarning(diagnosticOptions, severity) then diagnosticsLogger.DiagnosticSink(diagnostic, FSharpDiagnosticSeverity.Warning) - elif diagnostic.ReportAsInfo (diagnosticOptions, severity) then + elif diagnostic.ReportAsInfo(diagnosticOptions, severity) then diagnosticsLogger.DiagnosticSink(diagnostic, severity) override _.ErrorCount = diagnosticsLogger.ErrorCount diff --git a/src/Compiler/Driver/CompilerDiagnostics.fsi b/src/Compiler/Driver/CompilerDiagnostics.fsi index 5ab9d11e1df..5811a745af7 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fsi +++ b/src/Compiler/Driver/CompilerDiagnostics.fsi @@ -71,11 +71,7 @@ type PhasedDiagnostic with member ReportAsError: FSharpDiagnosticOptions * FSharpDiagnosticSeverity -> bool /// Output all of a diagnostic to a buffer, including range - member Output: - buf: StringBuilder * - tcConfig: TcConfig * - severity: FSharpDiagnosticSeverity -> - unit + member Output: buf: StringBuilder * tcConfig: TcConfig * severity: FSharpDiagnosticSeverity -> unit /// Write extra context information for a diagnostic member WriteWithContext: @@ -127,8 +123,5 @@ type FormattedDiagnostic = /// Used internally and in LegacyHostedCompilerForTesting val CollectFormattedDiagnostics: - tcConfig: TcConfig * - severity: FSharpDiagnosticSeverity * - PhasedDiagnostic * - suggestNames: bool -> + tcConfig: TcConfig * severity: FSharpDiagnosticSeverity * PhasedDiagnostic * suggestNames: bool -> FormattedDiagnostic[] diff --git a/src/Compiler/Driver/ScriptClosure.fs b/src/Compiler/Driver/ScriptClosure.fs index dc830aadf16..74a4c083a7d 100644 --- a/src/Compiler/Driver/ScriptClosure.fs +++ b/src/Compiler/Driver/ScriptClosure.fs @@ -585,7 +585,7 @@ module ScriptPreprocessClosure = (parseDiagnostics @ earlierDiagnostics @ metaDiagnostics @ resolutionDiagnostics) | _ -> [], [] // When no file existed. - let isRootRange (diagnostic: PhasedDiagnostic)= + let isRootRange (diagnostic: PhasedDiagnostic) = match diagnostic.Range with | Some m -> // Return true if the error was *not* from a #load-ed file. diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 3be283306d5..ec22943e9b3 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -77,7 +77,8 @@ type DiagnosticsLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, override x.DiagnosticSink(diagnostic, severity) = let tcConfig = TcConfig.Create(tcConfigB, validate = false) - if diagnostic.ReportAsError (tcConfig.diagnosticsOptions, severity) then + + if diagnostic.ReportAsError(tcConfig.diagnosticsOptions, severity) then if errors >= tcConfig.maxErrors then x.HandleTooManyErrors(FSComp.SR.fscTooManyErrors ()) exiter.Exit 1 @@ -93,10 +94,10 @@ type DiagnosticsLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, Debug.Assert(false, sprintf "Lookup exception in compiler: %s" (diagnostic.Exception.ToString())) | _ -> () - elif diagnostic.ReportAsWarning (tcConfig.diagnosticsOptions, severity) then + elif diagnostic.ReportAsWarning(tcConfig.diagnosticsOptions, severity) then x.HandleIssue(tcConfig, diagnostic, FSharpDiagnosticSeverity.Warning) - elif diagnostic.ReportAsInfo (tcConfig.diagnosticsOptions, severity) then + elif diagnostic.ReportAsInfo(tcConfig.diagnosticsOptions, severity) then x.HandleIssue(tcConfig, diagnostic, severity) /// Create an error logger that counts and prints errors @@ -108,13 +109,7 @@ let ConsoleDiagnosticsLogger (tcConfigB: TcConfigBuilder, exiter: Exiter) = member _.HandleIssue(tcConfig, diagnostic, severity) = DoWithDiagnosticColor severity (fun () -> - writeViaBuffer stderr (fun buf -> - diagnostic.Output( - buf, - tcConfig, - severity - ) - ) + writeViaBuffer stderr (fun buf -> diagnostic.Output(buf, tcConfig, severity)) stderr.WriteLine()) } :> DiagnosticsLogger @@ -169,7 +164,7 @@ let TypeCheck GetInitialTcState(rangeStartup, ccuName, tcConfig, tcGlobals, tcImports, tcEnv0, openDecls0) let eagerFormat (diag: PhasedDiagnostic) = - diag.EagerlyFormatCore (tcConfig.flatErrors, true) + diag.EagerlyFormatCore(tcConfig.flatErrors, true) CheckClosedInputSet( ctok, @@ -340,6 +335,7 @@ module InterfaceFileWriter = NicePrint.layoutImpliedSignatureOfModuleOrNamespace true denv infoReader AccessibleFromSomewhere range0 mexpr |> Display.squashTo 80 |> LayoutRender.showL + Printf.fprintf os "%s\n\n" text let writeHeader filePath os = diff --git a/src/Compiler/Driver/fsc.fsi b/src/Compiler/Driver/fsc.fsi index 51b7f2396b6..0760cbf5ec9 100644 --- a/src/Compiler/Driver/fsc.fsi +++ b/src/Compiler/Driver/fsc.fsi @@ -33,8 +33,7 @@ type DiagnosticsLoggerUpToMaxErrors = new: tcConfigB: TcConfigBuilder * exiter: Exiter * nameForDebugging: string -> DiagnosticsLoggerUpToMaxErrors /// Called when a diagnostic occurs - abstract HandleIssue: - tcConfig: TcConfig * diagnostic: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit + abstract HandleIssue: tcConfig: TcConfig * diagnostic: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit /// Called when 'too many errors' has occurred abstract HandleTooManyErrors: text: string -> unit From f71f23014bb9a5d6ad41b04646ab7b0a8c4dcc93 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 24 Aug 2022 18:36:08 +0100 Subject: [PATCH 13/33] fix flaterrors --- src/Compiler/Driver/CompilerDiagnostics.fs | 44 +++++++++++---------- src/Compiler/Driver/CompilerDiagnostics.fsi | 2 +- src/Compiler/Driver/fsc.fs | 2 +- src/Compiler/Interactive/fsi.fs | 2 +- 4 files changed, 26 insertions(+), 24 deletions(-) diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index 82d27832db4..a2fd68372c7 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -599,8 +599,8 @@ let (|InvalidArgument|_|) (exn: exn) = | :? ArgumentException as e -> Some e.Message | _ -> None -let OutputNameSuggestions (os: StringBuilder) canSuggestNames suggestionsF idText = - if canSuggestNames then +let OutputNameSuggestions (os: StringBuilder) suggestNames suggestionsF idText = + if suggestNames then let buffer = DiagnosticResolutionHints.SuggestionBuffer idText if not buffer.Disabled then @@ -617,7 +617,7 @@ let OutputNameSuggestions (os: StringBuilder) canSuggestNames suggestionsF idTex type Exception with - member exn.Output(os: StringBuilder, canSuggestNames) = + member exn.Output(os: StringBuilder, suggestNames) = match exn with | ConstraintSolverTupleDiffLengths (_, tl1, tl2, m, m2) -> @@ -730,11 +730,11 @@ type Exception with | ContextInfo.NoContext -> false | _ -> true) -> - e.Output(os, canSuggestNames) + e.Output(os, suggestNames) - | ErrorFromAddingTypeEquation(error = ConstraintSolverTypesNotInSubsumptionRelation _ as e) -> e.Output(os, canSuggestNames) + | ErrorFromAddingTypeEquation(error = ConstraintSolverTypesNotInSubsumptionRelation _ as e) -> e.Output(os, suggestNames) - | ErrorFromAddingTypeEquation(error = ConstraintSolverError _ as e) -> e.Output(os, canSuggestNames) + | ErrorFromAddingTypeEquation(error = ConstraintSolverError _ as e) -> e.Output(os, suggestNames) | ErrorFromAddingTypeEquation (g, denv, ty1, ty2, e, _) -> if not (typeEquiv g ty1 ty2) then @@ -743,12 +743,12 @@ type Exception with if ty1 <> ty2 + tpcs then os.AppendString(ErrorFromAddingTypeEquation2E().Format ty1 ty2 tpcs) - e.Output(os, canSuggestNames) + e.Output(os, suggestNames) | ErrorFromApplyingDefault (_, denv, _, defaultType, e, _) -> let defaultType = NicePrint.minimalStringOfType denv defaultType os.AppendString(ErrorFromApplyingDefault1E().Format defaultType) - e.Output(os, canSuggestNames) + e.Output(os, suggestNames) os.AppendString(ErrorFromApplyingDefault2E().Format) | ErrorsFromAddingSubsumptionConstraint (g, denv, ty1, ty2, e, contextInfo, _) -> @@ -767,9 +767,9 @@ type Exception with if ty1 <> (ty2 + tpcs) then os.AppendString(ErrorsFromAddingSubsumptionConstraintE().Format ty2 ty1 tpcs) else - e.Output(os, canSuggestNames) + e.Output(os, suggestNames) else - e.Output(os, canSuggestNames) + e.Output(os, suggestNames) | UpperCaseIdentifierInPattern _ -> os.AppendString(UpperCaseIdentifierInPatternE().Format) @@ -777,12 +777,12 @@ type Exception with | NotUpperCaseConstructorWithoutRQA _ -> os.AppendString(NotUpperCaseConstructorWithoutRQAE().Format) - | ErrorFromAddingConstraint (_, e, _) -> e.Output(os, canSuggestNames) + | ErrorFromAddingConstraint (_, e, _) -> e.Output(os, suggestNames) #if !NO_TYPEPROVIDERS | TypeProviders.ProvidedTypeResolutionNoRange e - | TypeProviders.ProvidedTypeResolution (_, e) -> e.Output(os, canSuggestNames) + | TypeProviders.ProvidedTypeResolution (_, e) -> e.Output(os, suggestNames) | :? TypeProviderError as e -> os.AppendString(e.ContextualErrorMessage) #endif @@ -945,7 +945,7 @@ type Exception with | UndefinedName (_, k, id, suggestionsF) -> os.AppendString(k (ConvertValLogicalNameToDisplayNameCore id.idText)) - OutputNameSuggestions os canSuggestNames suggestionsF id.idText + OutputNameSuggestions os suggestNames suggestionsF id.idText | InternalUndefinedItemRef (f, smr, ccuName, s) -> let _, errs = f (smr, ccuName, s) @@ -1651,7 +1651,7 @@ type Exception with | DiagnosticWithSuggestions (_, s, _, idText, suggestionF) -> os.AppendString(ConvertValLogicalNameToDisplayNameCore s) - OutputNameSuggestions os canSuggestNames suggestionF idText + OutputNameSuggestions os suggestNames suggestionF idText | InternalError (s, _) | InvalidArgument s @@ -1669,7 +1669,7 @@ type Exception with Debug.Assert(false, sprintf "Unexpected exception seen in compiler: %s\n%s" s (exn.ToString())) #endif - | WrappedError (e, _) -> e.Output(os, canSuggestNames) + | WrappedError (e, _) -> e.Output(os, suggestNames) | PatternMatchCompilation.MatchIncomplete (isComp, cexOpt, _) -> os.AppendString(MatchIncomplete1E().Format) @@ -1828,13 +1828,13 @@ type Exception with match warnings, errors with | _, e :: _ -> os.AppendString(HashLoadedSourceHasIssues2E().Format) - e.Output(os, canSuggestNames) + e.Output(os, suggestNames) | e :: _, _ -> os.AppendString(HashLoadedSourceHasIssues1E().Format) - e.Output(os, canSuggestNames) + e.Output(os, suggestNames) | [], [] -> os.AppendString(HashLoadedSourceHasIssues0E().Format) - infos.Head.Output(os, canSuggestNames) + infos.Head.Output(os, suggestNames) | HashLoadedScriptConsideredSource _ -> os.AppendString(HashLoadedScriptConsideredSourceE().Format) @@ -1850,7 +1850,7 @@ type Exception with | MSBuildReferenceResolutionError (code, message, _) -> os.AppendString(MSBuildReferenceResolutionErrorE().Format message code) // Strip TargetInvocationException wrappers - | :? TargetInvocationException as exn -> exn.InnerException.Output(os, canSuggestNames) + | :? TargetInvocationException as exn -> exn.InnerException.Output(os, suggestNames) | :? FileNotFoundException as exn -> Printf.bprintf os "%s" exn.Message @@ -1895,10 +1895,12 @@ type PhasedDiagnostic with x.OutputCore(os, flattenErrors, suggestNames) os.ToString() - member x.EagerlyFormatCore(flattenErrors: bool, suggestNames: bool) = + member x.EagerlyFormatCore(suggestNames: bool) = match x.Range with | Some m -> - let message = x.FormatCore(flattenErrors, suggestNames) + let buf = StringBuilder() + x.Exception.Output(buf, suggestNames) + let message = buf.ToString() let exn = DiagnosticWithText(x.Number, message, m) { Exception = exn; Phase = x.Phase } | None -> x diff --git a/src/Compiler/Driver/CompilerDiagnostics.fsi b/src/Compiler/Driver/CompilerDiagnostics.fsi index 5811a745af7..8e0890d4418 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fsi +++ b/src/Compiler/Driver/CompilerDiagnostics.fsi @@ -56,7 +56,7 @@ type PhasedDiagnostic with member Number: int /// Eagerly format a PhasedDiagnostic return as a new PhasedDiagnostic requiring no formatting of types. - member EagerlyFormatCore: flattenErrors: bool * suggestNames: bool -> PhasedDiagnostic + member EagerlyFormatCore: suggestNames: bool -> PhasedDiagnostic /// Format the core of the diagnostic as a string. Doesn't include the range information. member FormatCore: flattenErrors: bool * suggestNames: bool -> string diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index ec22943e9b3..9a5472f0bf0 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -164,7 +164,7 @@ let TypeCheck GetInitialTcState(rangeStartup, ccuName, tcConfig, tcGlobals, tcImports, tcEnv0, openDecls0) let eagerFormat (diag: PhasedDiagnostic) = - diag.EagerlyFormatCore(tcConfig.flatErrors, true) + diag.EagerlyFormatCore true CheckClosedInputSet( ctok, diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 122c51662cc..908b1d1dd01 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -1671,7 +1671,7 @@ type internal FsiDynamicCompiler( let tcConfig = TcConfig.Create(tcConfigB,validate=false) let eagerFormat (diag: PhasedDiagnostic) = - diag.EagerlyFormatCore (tcConfig.flatErrors, true) + diag.EagerlyFormatCore true // Typecheck. The lock stops the type checker running at the same time as the // server intellisense implementation (which is currently incomplete and #if disabled) From ad1c58bac0ba79fcc5d90fdc2a4198d9c5352525 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 24 Aug 2022 20:14:00 +0100 Subject: [PATCH 14/33] allow error recovery on collisions --- src/Compiler/Checking/CheckDeclarations.fs | 4 +- src/Compiler/Checking/import.fs | 2 +- src/Compiler/Driver/ParseAndCheckInputs.fs | 4 +- src/Compiler/TypedTree/TypedTreeOps.fs | 92 +++++++++++----------- src/Compiler/TypedTree/TypedTreeOps.fsi | 2 +- tests/fsharp/typecheck/sigs/neg10.bsl | 2 - 6 files changed, 54 insertions(+), 52 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index b9ce8888979..e1b424f3011 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4479,7 +4479,7 @@ let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcE // Publish the combined module type env.eModuleOrNamespaceTypeAccumulator.Value <- - CombineCcuContentFragments m [env.eModuleOrNamespaceTypeAccumulator.Value; modTyRoot] + CombineCcuContentFragments [env.eModuleOrNamespaceTypeAccumulator.Value; modTyRoot] env return env @@ -4801,7 +4801,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem // Publish the combined module type env.eModuleOrNamespaceTypeAccumulator.Value <- - CombineCcuContentFragments m [env.eModuleOrNamespaceTypeAccumulator.Value; modTyRoot] + CombineCcuContentFragments [env.eModuleOrNamespaceTypeAccumulator.Value; modTyRoot] env, openDecls let moduleContentsRoot = BuildRootModuleContents kind.IsModule enclosingNamespacePath envNS.eCompPath moduleContents diff --git a/src/Compiler/Checking/import.fs b/src/Compiler/Checking/import.fs index cca134f4d38..03e13801249 100644 --- a/src/Compiler/Checking/import.fs +++ b/src/Compiler/Checking/import.fs @@ -584,7 +584,7 @@ let ImportILAssemblyTypeDefs (amap, m, auxModLoader, aref, mainmod: ILModuleDef) let scoref = ILScopeRef.Assembly aref let mtypsForExportedTypes = ImportILAssemblyExportedTypes amap m auxModLoader scoref mainmod.ManifestOfAssembly.ExportedTypes let mainmod = ImportILAssemblyMainTypeDefs amap m scoref mainmod - CombineCcuContentFragments m (mainmod :: mtypsForExportedTypes) + CombineCcuContentFragments (mainmod :: mtypsForExportedTypes) /// Import the type forwarder table for an IL assembly let ImportILAssemblyTypeForwarders (amap, m, exportedTypes: ILExportedTypesAndForwarders): CcuTypeForwarderTable = diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index ae58312fc98..d470ff664b6 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1160,7 +1160,7 @@ let AddCheckResultsToTcState | _ -> tcSigEnv, [] let ccuSigForFile = - CombineCcuContentFragments m [ implFileSigType; tcState.tcsCcuSig ] + CombineCcuContentFragments [ implFileSigType; tcState.tcsCcuSig ] let tcState = { tcState with @@ -1249,7 +1249,7 @@ let CheckOneInputAux let rootSigs = Zmap.add qualNameOfFile sigFileType tcState.tcsRootSigs // Add the signature to the signature env (unless it had an explicit signature) - let ccuSigForFile = CombineCcuContentFragments m [ sigFileType; tcState.tcsCcuSig ] + let ccuSigForFile = CombineCcuContentFragments [ sigFileType; tcState.tcsCcuSig ] // Open the prefixPath for fsi.exe let tcEnv, _openDecls1 = diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 6678298f4b8..bc037c8af7e 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -10040,60 +10040,64 @@ let (|IfUseResumableStateMachinesExpr|_|) g expr = /// Combine a list of ModuleOrNamespaceType's making up the description of a CCU. checking there are now /// duplicate modules etc. -let CombineCcuContentFragments m l = +let CombineCcuContentFragments l = /// Combine module types when multiple namespace fragments contribute to the /// same namespace, making new module specs as we go. - let rec CombineModuleOrNamespaceTypes path m (mty1: ModuleOrNamespaceType) (mty2: ModuleOrNamespaceType) = - match mty1.ModuleOrNamespaceKind, mty2.ModuleOrNamespaceKind with - | Namespace _, Namespace _ -> - let kind = mty1.ModuleOrNamespaceKind - let tab1 = mty1.AllEntitiesByLogicalMangledName - let tab2 = mty2.AllEntitiesByLogicalMangledName - let entities = - [ for e1 in mty1.AllEntities do - match tab2.TryGetValue e1.LogicalName with - | true, e2 -> yield CombineEntities path e1 e2 - | _ -> yield e1 - for e2 in mty2.AllEntities do - match tab1.TryGetValue e2.LogicalName with - | true, _ -> () - | _ -> yield e2 ] - - let vals = QueueList.append mty1.AllValsAndMembers mty2.AllValsAndMembers - - ModuleOrNamespaceType(kind, vals, QueueList.ofList entities) - - | Namespace _, _ | _, Namespace _ -> - error(Error(FSComp.SR.tastNamespaceAndModuleWithSameNameInAssembly(textOfPath path), m)) - - | _-> - error(Error(FSComp.SR.tastTwoModulesWithSameNameInAssembly(textOfPath path), m)) + let rec CombineModuleOrNamespaceTypes path (mty1: ModuleOrNamespaceType) (mty2: ModuleOrNamespaceType) = + let kind = mty1.ModuleOrNamespaceKind + let tab1 = mty1.AllEntitiesByLogicalMangledName + let tab2 = mty2.AllEntitiesByLogicalMangledName + let entities = + [ + for e1 in mty1.AllEntities do + match tab2.TryGetValue e1.LogicalName with + | true, e2 -> yield CombineEntities path e1 e2 + | _ -> yield e1 + + for e2 in mty2.AllEntities do + match tab1.TryGetValue e2.LogicalName with + | true, _ -> () + | _ -> yield e2 + ] + + let vals = QueueList.append mty1.AllValsAndMembers mty2.AllValsAndMembers + + ModuleOrNamespaceType(kind, vals, QueueList.ofList entities) and CombineEntities path (entity1: Entity) (entity2: Entity) = - match entity1.IsModuleOrNamespace, entity2.IsModuleOrNamespace with - | true, true -> - entity1 |> Construct.NewModifiedTycon (fun data1 -> - let xml = XmlDoc.Merge entity1.XmlDoc entity2.XmlDoc - { data1 with - entity_attribs = entity1.Attribs @ entity2.Attribs - entity_modul_type = MaybeLazy.Lazy (lazy (CombineModuleOrNamespaceTypes (path@[entity2.DemangledModuleOrNamespaceName]) entity2.Range entity1.ModuleOrNamespaceType entity2.ModuleOrNamespaceType)) - entity_opt_data = - match data1.entity_opt_data with - | Some optData -> Some { optData with entity_xmldoc = xml } - | _ -> Some { Entity.NewEmptyEntityOptData() with entity_xmldoc = xml } }) - | false, false -> - error(Error(FSComp.SR.tastDuplicateTypeDefinitionInAssembly(entity2.LogicalName, textOfPath path), entity2.Range)) - | _, _ -> - error(Error(FSComp.SR.tastConflictingModuleAndTypeDefinitionInAssembly(entity2.LogicalName, textOfPath path), entity2.Range)) + let path2 = path@[entity2.DemangledModuleOrNamespaceName] + + match entity1.IsNamespace, entity2.IsNamespace, entity1.IsModule, entity2.IsModule with + | true, true, _, _ -> + () + | true, _, _, _ + | _, true, _, _ -> + errorR(Error(FSComp.SR.tastNamespaceAndModuleWithSameNameInAssembly(textOfPath path2), entity2.Range)) + | false, false, false, false -> + errorR(Error(FSComp.SR.tastDuplicateTypeDefinitionInAssembly(entity2.LogicalName, textOfPath path), entity2.Range)) + | false, false, true, true -> + errorR(Error(FSComp.SR.tastTwoModulesWithSameNameInAssembly(textOfPath path2), entity2.Range)) + | _ -> + errorR(Error(FSComp.SR.tastConflictingModuleAndTypeDefinitionInAssembly(entity2.LogicalName, textOfPath path), entity2.Range)) + + entity1 |> Construct.NewModifiedTycon (fun data1 -> + let xml = XmlDoc.Merge entity1.XmlDoc entity2.XmlDoc + { data1 with + entity_attribs = entity1.Attribs @ entity2.Attribs + entity_modul_type = MaybeLazy.Lazy (lazy (CombineModuleOrNamespaceTypes path2 entity1.ModuleOrNamespaceType entity2.ModuleOrNamespaceType)) + entity_opt_data = + match data1.entity_opt_data with + | Some optData -> Some { optData with entity_xmldoc = xml } + | _ -> Some { Entity.NewEmptyEntityOptData() with entity_xmldoc = xml } }) - and CombineModuleOrNamespaceTypeList path m l = + and CombineModuleOrNamespaceTypeList path l = match l with - | h :: t -> List.fold (CombineModuleOrNamespaceTypes path m) h t + | h :: t -> List.fold (CombineModuleOrNamespaceTypes path) h t | _ -> failwith "CombineModuleOrNamespaceTypeList" - CombineModuleOrNamespaceTypeList [] m l + CombineModuleOrNamespaceTypeList [] l /// An immutable mappping from witnesses to some data. /// diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index c4afc142086..403498c5417 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2565,7 +2565,7 @@ val (|DelegateInvokeExpr|_|): TcGlobals -> Expr -> (Expr * TType * Expr * Expr * /// Match 'if __useResumableCode then ... else ...' expressions val (|IfUseResumableStateMachinesExpr|_|): TcGlobals -> Expr -> (Expr * Expr) option -val CombineCcuContentFragments: range -> ModuleOrNamespaceType list -> ModuleOrNamespaceType +val CombineCcuContentFragments: ModuleOrNamespaceType list -> ModuleOrNamespaceType /// Recognise a 'match __resumableEntry() with ...' expression val (|ResumableEntryMatchExpr|_|): g: TcGlobals -> Expr -> (Expr * Val * Expr * (Expr * Expr -> Expr)) option diff --git a/tests/fsharp/typecheck/sigs/neg10.bsl b/tests/fsharp/typecheck/sigs/neg10.bsl index 40a58bfb096..ca47dbf94d0 100644 --- a/tests/fsharp/typecheck/sigs/neg10.bsl +++ b/tests/fsharp/typecheck/sigs/neg10.bsl @@ -245,5 +245,3 @@ neg10.fs(455,25,455,26): typecheck error FS0001: The type 'C' does not support a neg10.fs(456,24,456,25): typecheck error FS0001: The type 'C' does not support a conversion to the type 'int64' neg10.fs(457,26,457,27): typecheck error FS0001: The type 'C' does not support a conversion to the type 'decimal' - -neg10.fsi(1,1,1,1): typecheck error FS0240: The signature file 'Neg10' does not have a corresponding implementation file. If an implementation file exists then check the 'module' and 'namespace' declarations in the signature and implementation files match. From 2765915b35e45585b020f29cf76b742e14cd3652 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 24 Aug 2022 20:55:45 +0100 Subject: [PATCH 15/33] fix name generation to be deterministic --- src/Compiler/Checking/CheckDeclarations.fs | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index e1b424f3011..83c527ce177 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -688,11 +688,10 @@ let TcOpenDecl (cenv: cenv) mOpenDecl scopem env target = | SynOpenDeclTarget.Type (synType, m) -> TcOpenTypeDecl cenv mOpenDecl scopem env (synType, m) -let MakeSafeInitField (g: TcGlobals) env m isStatic = +let MakeSafeInitField (cenv: cenv) env m isStatic = let id = // Ensure that we have an g.CompilerGlobalState - assert(g.CompilerGlobalState |> Option.isSome) - ident(g.CompilerGlobalState.Value.NiceNameGenerator.FreshCompilerGeneratedName("init", m), m) + ident(cenv.niceNameGen.NiceNameGenerator.FreshCompilerGeneratedName("init", m), m) let taccess = TAccess [env.eAccessPath] Construct.NewRecdField isStatic None id false g.int_ty true true [] [] XmlDoc.Empty taccess true @@ -1268,7 +1267,7 @@ module MutRecBindingChecking = | _ -> false) if needsSafeStaticInit && hasStaticBindings then - let rfield = MakeSafeInitField g envForDecls tcref.Range true + let rfield = MakeSafeInitField cenv envForDecls tcref.Range true SafeInitField(mkRecdFieldRef tcref rfield.LogicalName, rfield) else NoSafeInitInfo @@ -2426,7 +2425,7 @@ module EstablishTypeDefinitionCores = let ComputeInstanceSafeInitInfo (cenv: cenv) env m thisTy = let g = cenv.g if InstanceMembersNeedSafeInitCheck cenv m thisTy then - let rfield = MakeSafeInitField g env m false + let rfield = MakeSafeInitField cenv env m false let tcref = tcrefOfAppTy g thisTy SafeInitField (mkRecdFieldRef tcref rfield.LogicalName, rfield) else From e9a213e3459a061306fb9f92a7b5721d4579ab3f Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 24 Aug 2022 21:36:31 +0100 Subject: [PATCH 16/33] fix build --- src/Compiler/Checking/CheckDeclarations.fs | 4 ++-- src/Compiler/Driver/fsc.fs | 3 +-- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 83c527ce177..0e3b8a7973b 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -691,9 +691,9 @@ let TcOpenDecl (cenv: cenv) mOpenDecl scopem env target = let MakeSafeInitField (cenv: cenv) env m isStatic = let id = // Ensure that we have an g.CompilerGlobalState - ident(cenv.niceNameGen.NiceNameGenerator.FreshCompilerGeneratedName("init", m), m) + ident(cenv.niceNameGen.FreshCompilerGeneratedName("init", m), m) let taccess = TAccess [env.eAccessPath] - Construct.NewRecdField isStatic None id false g.int_ty true true [] [] XmlDoc.Empty taccess true + Construct.NewRecdField isStatic None id false cenv.g.int_ty true true [] [] XmlDoc.Empty taccess true // Checking of mutually recursive types, members and 'let' bindings in classes // diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 9a5472f0bf0..5d8fea3f259 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -163,8 +163,7 @@ let TypeCheck let tcInitialState = GetInitialTcState(rangeStartup, ccuName, tcConfig, tcGlobals, tcImports, tcEnv0, openDecls0) - let eagerFormat (diag: PhasedDiagnostic) = - diag.EagerlyFormatCore true + let eagerFormat (diag: PhasedDiagnostic) = diag.EagerlyFormatCore true CheckClosedInputSet( ctok, From b75d081fc4207a625576ec21d7cb7c3f616054e2 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 24 Aug 2022 22:34:30 +0100 Subject: [PATCH 17/33] Update RecursiveSafetyAnalysis.fs --- .../RecursiveSafetyAnalysis/RecursiveSafetyAnalysis.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/InferenceProcedures/RecursiveSafetyAnalysis/RecursiveSafetyAnalysis.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/InferenceProcedures/RecursiveSafetyAnalysis/RecursiveSafetyAnalysis.fs index 39ad13a3e9e..f75ee8440a2 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/InferenceProcedures/RecursiveSafetyAnalysis/RecursiveSafetyAnalysis.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/InferenceProcedures/RecursiveSafetyAnalysis/RecursiveSafetyAnalysis.fs @@ -25,7 +25,7 @@ module RecursiveSafetyAnalysis = |> shouldFail |> withDiagnostics [ (Error 953, Line 6, Col 6, Line 6, Col 15, "This type definition involves an immediate cyclic reference through an abbreviation") - (Error 1, Line 8, Col 25, Line 8, Col 34, "This expression was expected to have type 'bogusType' but here has type 'Map<'a,'b>'") + (Error 1, Line 8, Col 25, Line 8, Col 34, "This expression was expected to have type\n 'bogusType' \nbut here has type\n 'Map<'a,'b>' ") ] // SOURCE=E_DuplicateRecursiveRecords.fs SCFLAGS="--test:ErrorRanges" # E_DuplicateRecursiveRecords.fs From f4f0e7e5173f525b4c3ff6476d82f60c9f01fbf4 Mon Sep 17 00:00:00 2001 From: nojaf Date: Tue, 30 Aug 2022 10:57:24 +0200 Subject: [PATCH 18/33] Add flag for parallel type checking of files backed by signatures. --- src/Compiler/Driver/CompilerConfig.fs | 3 +++ src/Compiler/Driver/CompilerConfig.fsi | 4 ++++ src/Compiler/Driver/CompilerOptions.fs | 1 + src/Compiler/Driver/ParseAndCheckInputs.fs | 8 +------- src/Compiler/Service/IncrementalBuild.fs | 3 +++ src/Compiler/Service/IncrementalBuild.fsi | 1 + src/Compiler/Service/service.fs | 17 ++++++++++++----- src/Compiler/Service/service.fsi | 4 +++- ...ilerService.SurfaceArea.netstandard.expected | 2 +- 9 files changed, 29 insertions(+), 14 deletions(-) diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs index 753288833ac..774cb954ca9 100644 --- a/src/Compiler/Driver/CompilerConfig.fs +++ b/src/Compiler/Driver/CompilerConfig.fs @@ -502,6 +502,7 @@ type TcConfigBuilder = mutable emitTailcalls: bool mutable deterministic: bool mutable concurrentBuild: bool + mutable parallelCheckingWithSignatureFiles: bool mutable emitMetadataAssembly: MetadataAssemblyGeneration mutable preferredUiLang: string option mutable lcid: int option @@ -725,6 +726,7 @@ type TcConfigBuilder = emitTailcalls = true deterministic = false concurrentBuild = true + parallelCheckingWithSignatureFiles = false emitMetadataAssembly = MetadataAssemblyGeneration.None preferredUiLang = None lcid = None @@ -1276,6 +1278,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member _.emitTailcalls = data.emitTailcalls member _.deterministic = data.deterministic member _.concurrentBuild = data.concurrentBuild + member _.parallelCheckingWithSignatureFiles = data.parallelCheckingWithSignatureFiles member _.emitMetadataAssembly = data.emitMetadataAssembly member _.pathMap = data.pathMap member _.langVersion = data.langVersion diff --git a/src/Compiler/Driver/CompilerConfig.fsi b/src/Compiler/Driver/CompilerConfig.fsi index e200fb03e02..342c767bbb2 100644 --- a/src/Compiler/Driver/CompilerConfig.fsi +++ b/src/Compiler/Driver/CompilerConfig.fsi @@ -407,6 +407,8 @@ type TcConfigBuilder = mutable concurrentBuild: bool + mutable parallelCheckingWithSignatureFiles: bool + mutable emitMetadataAssembly: MetadataAssemblyGeneration mutable preferredUiLang: string option @@ -723,6 +725,8 @@ type TcConfig = member concurrentBuild: bool + member parallelCheckingWithSignatureFiles: bool + member emitMetadataAssembly: MetadataAssemblyGeneration member pathMap: PathMap diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index ca6119460e5..090131c2e3c 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -1387,6 +1387,7 @@ let testFlag tcConfigB = | "ShowLoadedAssemblies" -> tcConfigB.showLoadedAssemblies <- true | "ContinueAfterParseFailure" -> tcConfigB.continueAfterParseFailure <- true | "ParallelOff" -> tcConfigB.concurrentBuild <- false + | "ParallelCheckingWithSignatureFilesOn" -> tcConfigB.parallelCheckingWithSignatureFiles <- true #if DEBUG | "ShowParserStackOnParseError" -> showParserStackOnParseError <- true #endif diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index d470ff664b6..2ba11b3bb8c 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1554,15 +1554,9 @@ let CheckMultipleInputsInParallel finishedResults, tcState) let CheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, eagerFormat, inputs) = - - let disableParallel = - Environment.GetEnvironmentVariable("FSHARP_NO_PARALLEL_CHECKING") - |> String.IsNullOrWhiteSpace - |> not - // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions let results, tcState = - if tcConfig.concurrentBuild && not disableParallel then + if tcConfig.parallelCheckingWithSignatureFiles then CheckMultipleInputsInParallel(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, eagerFormat, inputs) else CheckMultipleInputsSequential(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index fd1b8e60bec..a1673102dc2 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -1431,6 +1431,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking: bool, + enableParallelCheckingWithSignatureFiles: bool, dependencyProvider ) = @@ -1512,6 +1513,8 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc } |> Some + tcConfigB.parallelCheckingWithSignatureFiles <- enableParallelCheckingWithSignatureFiles + tcConfigB, sourceFilesNew // If this is a builder for a script, re-apply the settings inferred from the diff --git a/src/Compiler/Service/IncrementalBuild.fsi b/src/Compiler/Service/IncrementalBuild.fsi index cca65bcace1..4843a5061e7 100755 --- a/src/Compiler/Service/IncrementalBuild.fsi +++ b/src/Compiler/Service/IncrementalBuild.fsi @@ -263,6 +263,7 @@ type internal IncrementalBuilder = keepAllBackgroundSymbolUses: bool * enableBackgroundItemKeyStoreAndSemanticClassification: bool * enablePartialTypeChecking: bool * + enableParallelCheckingWithSignatureFiles: bool * dependencyProvider: DependencyProvider option -> NodeCode diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index b60bf55cef3..b245d6fa4c9 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -281,7 +281,8 @@ type BackgroundCompiler suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking + enablePartialTypeChecking, + enableParallelCheckingWithSignatureFiles ) as self = let beforeFileChecked = Event() @@ -408,6 +409,7 @@ type BackgroundCompiler keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking, + enableParallelCheckingWithSignatureFiles, dependencyProvider ) @@ -1200,7 +1202,8 @@ type FSharpChecker suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking + enablePartialTypeChecking, + enableParallelCheckingWithSignatureFiles ) = let backgroundCompiler = @@ -1213,7 +1216,8 @@ type FSharpChecker suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking + enablePartialTypeChecking, + enableParallelCheckingWithSignatureFiles ) static let globalInstance = lazy FSharpChecker.Create() @@ -1236,7 +1240,8 @@ type FSharpChecker ?suggestNamesForErrors, ?keepAllBackgroundSymbolUses, ?enableBackgroundItemKeyStoreAndSemanticClassification, - ?enablePartialTypeChecking + ?enablePartialTypeChecking, + ?enableParallelCheckingWithSignatureFiles ) = let legacyReferenceResolver = @@ -1255,6 +1260,7 @@ type FSharpChecker defaultArg enableBackgroundItemKeyStoreAndSemanticClassification false let enablePartialTypeChecking = defaultArg enablePartialTypeChecking false + let enableParallelCheckingWithSignatureFiles = defaultArg enableParallelCheckingWithSignatureFiles false if keepAssemblyContents && enablePartialTypeChecking then invalidArg "enablePartialTypeChecking" "'keepAssemblyContents' and 'enablePartialTypeChecking' cannot be both enabled." @@ -1268,7 +1274,8 @@ type FSharpChecker suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking + enablePartialTypeChecking, + enableParallelCheckingWithSignatureFiles ) member _.ReferenceResolver = legacyReferenceResolver diff --git a/src/Compiler/Service/service.fsi b/src/Compiler/Service/service.fsi index 25a5a2b412e..cec0eb2d2f2 100644 --- a/src/Compiler/Service/service.fsi +++ b/src/Compiler/Service/service.fsi @@ -31,6 +31,7 @@ type public FSharpChecker = /// Indicate whether all symbol uses should be kept in background checking /// Indicates whether a table of symbol keys should be kept for background compilation /// Indicates whether to perform partial type checking. Cannot be set to true if keepAssmeblyContents is true. If set to true, can cause duplicate type-checks when richer information on a file is needed, but can skip background type-checking entirely on implementation files with signature files. + /// Type check implementation files that are backed by a signature file in parallel. static member Create: ?projectCacheSize: int * ?keepAssemblyContents: bool * @@ -40,7 +41,8 @@ type public FSharpChecker = ?suggestNamesForErrors: bool * ?keepAllBackgroundSymbolUses: bool * ?enableBackgroundItemKeyStoreAndSemanticClassification: bool * - ?enablePartialTypeChecking: bool -> + ?enablePartialTypeChecking: bool * + ?enableParallelCheckingWithSignatureFiles: bool -> FSharpChecker /// diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected index 51d287c47c0..6f38d493913 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected @@ -2008,7 +2008,7 @@ FSharp.Compiler.CodeAnalysis.FSharpCheckProjectResults: System.String ToString() FSharp.Compiler.CodeAnalysis.FSharpCheckProjectResults: System.String[] DependencyFiles FSharp.Compiler.CodeAnalysis.FSharpCheckProjectResults: System.String[] get_DependencyFiles() FSharp.Compiler.CodeAnalysis.FSharpChecker -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 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], 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], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean]) From 61dc6c1145837eb999d17d94c6141e7a92f91542 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 9 Sep 2022 18:20:55 +0100 Subject: [PATCH 19/33] Update src/Compiler/Driver/ParseAndCheckInputs.fs Co-authored-by: Petr Pokorny --- src/Compiler/Driver/ParseAndCheckInputs.fs | 23 ++++++---------------- 1 file changed, 6 insertions(+), 17 deletions(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 2ba11b3bb8c..af4d1c44df5 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1495,7 +1495,7 @@ let CheckMultipleInputsInParallel partialResult, (tcState, priorErrors)) // Do the parallel phase, checking all implementation files that did have a signature, in parallel. - let unfinishedResults = + let results, createsGeneratedProvidedTypesFlags = List.zip partialResults inputsWithLoggers |> List.toArray @@ -1506,7 +1506,7 @@ let CheckMultipleInputsInParallel RequireCompilationThread ctok match partialResult with - | Choice1Of2 result -> Choice1Of2 result + | Choice1Of2 result -> result, false | Choice2Of2 (amap, conditionalDefines, rootSig, priorErrors, file, tcStateForImplFile, ccuSigForFile) -> // In the first linear part of parallel checking, we use a 'checkForErrors' that checks either for errors @@ -1531,27 +1531,16 @@ let CheckMultipleInputsInParallel |> Cancellable.runWithoutCancellation let result = (tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile) - Choice2Of2(result, createsGeneratedProvidedTypes)) + result, createsGeneratedProvidedTypes) |> Array.toList - - let createsGeneratedProvidedTypes = - unfinishedResults - |> List.exists (function - | Choice1Of2 _ -> false - | Choice2Of2 (_, flag) -> flag) + |> List.unzip let tcState = { tcState with - tcsCreatesGeneratedProvidedTypes = tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes + tcsCreatesGeneratedProvidedTypes = tcState.tcsCreatesGeneratedProvidedTypes || (createsGeneratedProvidedTypesFlags |> List.exists id) } - let finishedResults = - unfinishedResults - |> List.map (function - | Choice1Of2 result -> result - | Choice2Of2 (result, _) -> result) - - finishedResults, tcState) + results, tcState) let CheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, eagerFormat, inputs) = // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions From 5ad1f0f4be507df14fc7c5719b73b97413da5191 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 9 Sep 2022 18:26:56 +0100 Subject: [PATCH 20/33] format code --- src/Compiler/Driver/ParseAndCheckInputs.fs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index af4d1c44df5..5a17b8a09bd 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1537,7 +1537,9 @@ let CheckMultipleInputsInParallel let tcState = { tcState with - tcsCreatesGeneratedProvidedTypes = tcState.tcsCreatesGeneratedProvidedTypes || (createsGeneratedProvidedTypesFlags |> List.exists id) + tcsCreatesGeneratedProvidedTypes = + tcState.tcsCreatesGeneratedProvidedTypes + || (createsGeneratedProvidedTypesFlags |> List.exists id) } results, tcState) From ee784d922c615ef3034b23410f1c63b55069f19f Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 9 Sep 2022 19:52:17 +0100 Subject: [PATCH 21/33] Update TypeTests.fs --- tests/service/SyntaxTreeTests/TypeTests.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/service/SyntaxTreeTests/TypeTests.fs b/tests/service/SyntaxTreeTests/TypeTests.fs index ef8aa1aa901..0670339ed6a 100644 --- a/tests/service/SyntaxTreeTests/TypeTests.fs +++ b/tests/service/SyntaxTreeTests/TypeTests.fs @@ -494,7 +494,7 @@ let _: struct (int * int) = () """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [ SynBinding(returnInfo = Some (SynBindingReturnInfo(typeName = SynType.Tuple(true, [ SynTupleTypeSegment.Type _ ; SynTupleTypeSegment.Star _ ; SynTupleTypeSegment.Type _ ], mTuple)))) ]) @@ -514,7 +514,7 @@ let _: struct (int * int = () """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Let(bindings = [ SynBinding(returnInfo = Some (SynBindingReturnInfo(typeName = SynType.Tuple(true, [ SynTupleTypeSegment.Type _ ; SynTupleTypeSegment.Star _ ; SynTupleTypeSegment.Type _ ], mTuple)))) ]) From 97fbf63f1b04c3d9abc49af0579a5a9a9a4dbb58 Mon Sep 17 00:00:00 2001 From: nojaf Date: Mon, 12 Sep 2022 11:37:43 +0200 Subject: [PATCH 22/33] Prefix DiagnosticsLoggerProvider with I --- src/Compiler/Driver/fsc.fs | 10 +++++----- src/Compiler/Driver/fsc.fsi | 8 ++++---- src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs | 2 +- src/Compiler/Service/service.fs | 2 +- 4 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 5d8fea3f259..3a7298714f0 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -117,21 +117,21 @@ let ConsoleDiagnosticsLogger (tcConfigB: TcConfigBuilder, exiter: Exiter) = /// DiagnosticLoggers can be sensitive to the TcConfig flags. During the checking /// of the flags themselves we have to create temporary loggers, until the full configuration is /// available. -type DiagnosticsLoggerProvider = +type IDiagnosticsLoggerProvider = abstract CreateLogger: tcConfigB: TcConfigBuilder * exiter: Exiter -> DiagnosticsLogger type CapturingDiagnosticsLogger with /// Commit the delayed diagnostics via a fresh temporary logger of the right kind. - member x.CommitDelayedDiagnostics(diagnosticsLoggerProvider: DiagnosticsLoggerProvider, tcConfigB, exiter) = + member x.CommitDelayedDiagnostics(diagnosticsLoggerProvider: IDiagnosticsLoggerProvider, tcConfigB, exiter) = let diagnosticsLogger = diagnosticsLoggerProvider.CreateLogger(tcConfigB, exiter) x.CommitDelayedDiagnostics diagnosticsLogger /// The default DiagnosticsLogger implementation, reporting messages to the Console up to the maxerrors maximum type ConsoleLoggerProvider() = - interface DiagnosticsLoggerProvider with + interface IDiagnosticsLoggerProvider with member _.CreateLogger(tcConfigB, exiter) = ConsoleDiagnosticsLogger(tcConfigB, exiter) @@ -462,7 +462,7 @@ let main1 reduceMemoryUsage: ReduceMemoryFlag, defaultCopyFSharpCore: CopyFSharpCoreFlag, exiter: Exiter, - diagnosticsLoggerProvider: DiagnosticsLoggerProvider, + diagnosticsLoggerProvider: IDiagnosticsLoggerProvider, disposables: DisposablesTracker ) = @@ -690,7 +690,7 @@ let main1OfAst dllReferences, noframework, exiter: Exiter, - diagnosticsLoggerProvider: DiagnosticsLoggerProvider, + diagnosticsLoggerProvider: IDiagnosticsLoggerProvider, disposables: DisposablesTracker, inputs: ParsedInput list ) = diff --git a/src/Compiler/Driver/fsc.fsi b/src/Compiler/Driver/fsc.fsi index 0760cbf5ec9..bb060095d98 100644 --- a/src/Compiler/Driver/fsc.fsi +++ b/src/Compiler/Driver/fsc.fsi @@ -16,13 +16,13 @@ open FSharp.Compiler.TcGlobals /// DiagnosticLoggers can be sensitive to the TcConfig flags. During the checking /// of the flags themselves we have to create temporary loggers, until the full configuration is /// available. -type DiagnosticsLoggerProvider = +type IDiagnosticsLoggerProvider = abstract CreateLogger: tcConfigB: TcConfigBuilder * exiter: Exiter -> DiagnosticsLogger /// The default DiagnosticsLoggerProvider implementation, reporting messages to the Console up to the maxerrors maximum type ConsoleLoggerProvider = new: unit -> ConsoleLoggerProvider - interface DiagnosticsLoggerProvider + interface IDiagnosticsLoggerProvider /// An diagnostic logger that reports errors up to some maximum, notifying the exiter when that maximum is reached /// @@ -51,7 +51,7 @@ val CompileFromCommandLineArguments: reduceMemoryUsage: ReduceMemoryFlag * defaultCopyFSharpCore: CopyFSharpCoreFlag * exiter: Exiter * - loggerProvider: DiagnosticsLoggerProvider * + loggerProvider: IDiagnosticsLoggerProvider * tcImportsCapture: (TcImports -> unit) option * dynamicAssemblyCreator: (TcConfig * TcGlobals * string * ILModuleDef -> unit) option -> unit @@ -68,7 +68,7 @@ val CompileFromSyntaxTrees: dependencies: string list * noframework: bool * exiter: Exiter * - loggerProvider: DiagnosticsLoggerProvider * + loggerProvider: IDiagnosticsLoggerProvider * inputs: ParsedInput list * tcImportsCapture: (TcImports -> unit) option * dynamicAssemblyCreator: (TcConfig * TcGlobals * string * ILModuleDef -> unit) option -> diff --git a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs index c8a73fdba36..b4af719fa39 100644 --- a/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs +++ b/src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs @@ -24,7 +24,7 @@ type internal InProcDiagnosticsLoggerProvider() = let warnings = ResizeArray() member _.Provider = - { new DiagnosticsLoggerProvider with + { new IDiagnosticsLoggerProvider with member _.CreateLogger(tcConfigB, exiter) = diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index b245d6fa4c9..d9906121964 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -98,7 +98,7 @@ module CompileHelpers = } let loggerProvider = - { new DiagnosticsLoggerProvider with + { new IDiagnosticsLoggerProvider with member _.CreateLogger(_tcConfigB, _exiter) = diagnosticsLogger } From 9cbb6e06290d9f93896f9f0193a1b4a53c0201ad Mon Sep 17 00:00:00 2001 From: nojaf Date: Mon, 12 Sep 2022 11:39:42 +0200 Subject: [PATCH 23/33] Remove duplicate hadSig binding. --- src/Compiler/Driver/ParseAndCheckInputs.fs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 5a17b8a09bd..f378fe16dc1 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1294,7 +1294,6 @@ let CheckOneInputAux // in the compilation order. let tcStateForImplFile = tcState let qualNameOfFile = file.QualifiedName - let hadSig = true let priorErrors = checkForErrors () let ccuSigForFile, tcState = From 8ace572b58af7b7c2e7f7c0ae3d717b989f6c492 Mon Sep 17 00:00:00 2001 From: nojaf Date: Mon, 12 Sep 2022 12:03:11 +0200 Subject: [PATCH 24/33] Add basic test for ParallelCheckingWithSignatureFiles flag. --- .../FSharp.Compiler.ComponentTests.fsproj | 1 + ...ParallelCheckingWithSignatureFilesTests.fs | 61 +++++++++++++++++++ 2 files changed, 62 insertions(+) create mode 100644 tests/FSharp.Compiler.ComponentTests/TypeChecks/ParallelCheckingWithSignatureFilesTests.fs diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index e6e08b27af7..105a6acff8e 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -183,6 +183,7 @@ + diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/ParallelCheckingWithSignatureFilesTests.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/ParallelCheckingWithSignatureFilesTests.fs new file mode 100644 index 00000000000..9e187de1388 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/ParallelCheckingWithSignatureFilesTests.fs @@ -0,0 +1,61 @@ +module FSharp.Compiler.ComponentTests.TypeChecks.ParallelCheckingWithSignatureFilesTests + +open Xunit +open FSharp.Test +open FSharp.Test.Compiler + +[] +let ``Parallel type checking when signature files are available`` () = + // File structure: + // Encode.fsi + // Encode.fs + // Decode.fsi + // Decode.fs + // Program.fs + + let encodeFsi = + Fsi + """ +module Encode + +val encode: obj -> string +""" + + let encodeFs = + SourceCodeFileKind.Create( + "Encode.fs", + """ +module Encode + +let encode (v: obj) : string = failwith "todo" +""" + ) + + let decodeFsi = + SourceCodeFileKind.Create( + "Decode.fsi", + """ +module Decode + +val decode: string -> obj +""" + ) + + let decodeFs = + SourceCodeFileKind.Create( + "Decode.fs", + """ +module Decode + +let decode (v: string) : obj = failwith "todo" +""" + ) + + let programFs = SourceCodeFileKind.Create("Program.fs", "printfn \"Hello from F#\"") + + encodeFsi + |> withAdditionalSourceFiles [ encodeFs; decodeFsi; decodeFs; programFs ] + |> withOptions [ "--test:ParallelCheckingWithSignatureFilesOn" ] + |> asExe + |> compile + |> shouldSucceed From 0880ba084865ee38e2bbbeae9cbc550d348c24b6 Mon Sep 17 00:00:00 2001 From: nojaf Date: Mon, 12 Sep 2022 15:06:12 +0200 Subject: [PATCH 25/33] Add additional CI job. --- FSharpBuild.Directory.Build.props | 1 + azure-pipelines.yml | 31 +++++++++++++++++++++++++++++++ 2 files changed, 32 insertions(+) diff --git a/FSharpBuild.Directory.Build.props b/FSharpBuild.Directory.Build.props index 7a349c38471..0c8d9cef75c 100644 --- a/FSharpBuild.Directory.Build.props +++ b/FSharpBuild.Directory.Build.props @@ -26,6 +26,7 @@ 1182;0025;$(WarningsAsErrors) $(OtherFlags) --nowarn:3384 $(OtherFlags) --times --nowarn:75 + $(OtherFlags) --test:ParallelCheckingWithSignatureFilesOn diff --git a/azure-pipelines.yml b/azure-pipelines.yml index 65e3e0fa007..3cb1d460dcd 100644 --- a/azure-pipelines.yml +++ b/azure-pipelines.yml @@ -234,6 +234,37 @@ stages: continueOnError: true condition: not(succeeded()) + # Run Build with --test:ParallelCheckingWithSignatureFilesOn + - job: ParallelCheckingWithSignatureFiles + condition: eq(variables['Build.Reason'], 'PullRequest') + variables: + - name: _SignType + value: Test + pool: + name: NetCore-Public + demands: ImageOverride -equals $(WindowsMachineQueueName) + timeoutInMinutes: 90 + steps: + - checkout: self + clean: true + - task: UseDotNet@2 + displayName: install SDK + inputs: + packageType: sdk + useGlobalJson: true + includePreviewVersions: false + workingDirectory: $(Build.SourcesDirectory) + installationPath: $(Build.SourcesDirectory)/.dotnet + - script: .\build.cmd -noVisualStudio /p:ParallelCheckingWithSignatureFilesOn=true + displayName: ParallelCheckingWithSignatureFiles build with Debug configuration + - task: PublishPipelineArtifact@1 + displayName: Publish ParallelCheckingWithSignatureFiles Logs + inputs: + targetPath: '$(Build.SourcesDirectory)/artifacts/log/Debug' + artifactName: 'ParallelCheckingWithSignatureFiles Attempt $(System.JobAttempt) Logs' + continueOnError: true + condition: not(succeeded()) + # Check code formatting - job: CheckCodeFormatting pool: From 01492591ca57ff52c909dacc040a09aea1b0eabb Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 12 Sep 2022 16:31:13 +0200 Subject: [PATCH 26/33] Produce binlog for ParallelCheckingWithSignatureFiles --- azure-pipelines.yml | 61 ++++++++++++++++++++++----------------------- 1 file changed, 30 insertions(+), 31 deletions(-) diff --git a/azure-pipelines.yml b/azure-pipelines.yml index 3cb1d460dcd..89691629087 100644 --- a/azure-pipelines.yml +++ b/azure-pipelines.yml @@ -234,37 +234,6 @@ stages: continueOnError: true condition: not(succeeded()) - # Run Build with --test:ParallelCheckingWithSignatureFilesOn - - job: ParallelCheckingWithSignatureFiles - condition: eq(variables['Build.Reason'], 'PullRequest') - variables: - - name: _SignType - value: Test - pool: - name: NetCore-Public - demands: ImageOverride -equals $(WindowsMachineQueueName) - timeoutInMinutes: 90 - steps: - - checkout: self - clean: true - - task: UseDotNet@2 - displayName: install SDK - inputs: - packageType: sdk - useGlobalJson: true - includePreviewVersions: false - workingDirectory: $(Build.SourcesDirectory) - installationPath: $(Build.SourcesDirectory)/.dotnet - - script: .\build.cmd -noVisualStudio /p:ParallelCheckingWithSignatureFilesOn=true - displayName: ParallelCheckingWithSignatureFiles build with Debug configuration - - task: PublishPipelineArtifact@1 - displayName: Publish ParallelCheckingWithSignatureFiles Logs - inputs: - targetPath: '$(Build.SourcesDirectory)/artifacts/log/Debug' - artifactName: 'ParallelCheckingWithSignatureFiles Attempt $(System.JobAttempt) Logs' - continueOnError: true - condition: not(succeeded()) - # Check code formatting - job: CheckCodeFormatting pool: @@ -539,6 +508,36 @@ stages: # filePath: eng\tests\UpToDate.ps1 # arguments: -configuration $(_BuildConfig) -ci -binaryLog + # Run Build with --test:ParallelCheckingWithSignatureFilesOn + - job: ParallelCheckingWithSignatureFiles + condition: eq(variables['Build.Reason'], 'PullRequest') + variables: + - name: _SignType + value: Test + pool: + name: NetCore-Public + demands: ImageOverride -equals $(WindowsMachineQueueName) + timeoutInMinutes: 90 + steps: + - checkout: self + clean: true + - task: UseDotNet@2 + displayName: install SDK + inputs: + packageType: sdk + useGlobalJson: true + includePreviewVersions: false + workingDirectory: $(Build.SourcesDirectory) + installationPath: $(Build.SourcesDirectory)/.dotnet + - script: .\build.cmd -noVisualStudio /p:ParallelCheckingWithSignatureFilesOn=true /bl:\"artifacts/log/$(_BuildConfig)/ParallelCheckingWithSignatureFiles.binlog\" + displayName: ParallelCheckingWithSignatureFiles build with Debug configuration + - task: PublishPipelineArtifact@1 + displayName: Publish ParallelCheckingWithSignatureFiles Logs + inputs: + targetPath: '$(Build.SourcesDirectory)/artifacts/log/$(_BuildConfig)' + artifactName: 'ParallelCheckingWithSignatureFiles Attempt $(System.JobAttempt) Logs' + continueOnError: true + # Plain build Windows - job: Plain_Build_Windows pool: From 73b166c093b5ce30b9c2cf8a65a23af0adbc3284 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 12 Sep 2022 17:10:34 +0200 Subject: [PATCH 27/33] Update azure-pipelines.yml --- azure-pipelines.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/azure-pipelines.yml b/azure-pipelines.yml index 89691629087..debde2dddb3 100644 --- a/azure-pipelines.yml +++ b/azure-pipelines.yml @@ -529,7 +529,7 @@ stages: includePreviewVersions: false workingDirectory: $(Build.SourcesDirectory) installationPath: $(Build.SourcesDirectory)/.dotnet - - script: .\build.cmd -noVisualStudio /p:ParallelCheckingWithSignatureFilesOn=true /bl:\"artifacts/log/$(_BuildConfig)/ParallelCheckingWithSignatureFiles.binlog\" + - script: .\build.cmd -binaryLog /p:ParallelCheckingWithSignatureFilesOn=true displayName: ParallelCheckingWithSignatureFiles build with Debug configuration - task: PublishPipelineArtifact@1 displayName: Publish ParallelCheckingWithSignatureFiles Logs From 3e887362cade232fefc44f56e3bcbe9404f0bdad Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 12 Sep 2022 18:18:09 +0200 Subject: [PATCH 28/33] Update azure-pipelines.yml --- azure-pipelines.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/azure-pipelines.yml b/azure-pipelines.yml index debde2dddb3..d739dc40ac2 100644 --- a/azure-pipelines.yml +++ b/azure-pipelines.yml @@ -529,12 +529,12 @@ stages: includePreviewVersions: false workingDirectory: $(Build.SourcesDirectory) installationPath: $(Build.SourcesDirectory)/.dotnet - - script: .\build.cmd -binaryLog /p:ParallelCheckingWithSignatureFilesOn=true + - script: .\build.cmd -c Release -binaryLog /p:ParallelCheckingWithSignatureFilesOn=true displayName: ParallelCheckingWithSignatureFiles build with Debug configuration - task: PublishPipelineArtifact@1 displayName: Publish ParallelCheckingWithSignatureFiles Logs inputs: - targetPath: '$(Build.SourcesDirectory)/artifacts/log/$(_BuildConfig)' + targetPath: '$(Build.SourcesDirectory)/artifacts/log/Release' artifactName: 'ParallelCheckingWithSignatureFiles Attempt $(System.JobAttempt) Logs' continueOnError: true From 60df51dd7157106faddc32776cf5feb23654b87a Mon Sep 17 00:00:00 2001 From: nojaf Date: Thu, 15 Sep 2022 15:17:14 +0200 Subject: [PATCH 29/33] Update TypeTests.fs --- tests/service/SyntaxTreeTests/TypeTests.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/service/SyntaxTreeTests/TypeTests.fs b/tests/service/SyntaxTreeTests/TypeTests.fs index 0670339ed6a..874c1f41dac 100644 --- a/tests/service/SyntaxTreeTests/TypeTests.fs +++ b/tests/service/SyntaxTreeTests/TypeTests.fs @@ -534,7 +534,7 @@ type Foo = delegate of a: A * b: B -> c:C -> D """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(kind = @@ -569,7 +569,7 @@ type X = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel( From 703da1ccf244a684a331492c39ae49189923848e Mon Sep 17 00:00:00 2001 From: nojaf Date: Thu, 15 Sep 2022 17:45:21 +0200 Subject: [PATCH 30/33] Update SyntaxTreeTests --- .../SyntaxTreeTests/SignatureTypeTests.fs | 54 +++++++++---------- .../service/SyntaxTreeTests/UnionCaseTests.fs | 2 +- 2 files changed, 28 insertions(+), 28 deletions(-) diff --git a/tests/service/SyntaxTreeTests/SignatureTypeTests.fs b/tests/service/SyntaxTreeTests/SignatureTypeTests.fs index b90439bd0ac..4918518de32 100644 --- a/tests/service/SyntaxTreeTests/SignatureTypeTests.fs +++ b/tests/service/SyntaxTreeTests/SignatureTypeTests.fs @@ -19,7 +19,7 @@ type Meh = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ - SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types(range = r)]) ])) -> + SynModuleOrNamespaceSig(decls = [SyncontentsigDecl.Types(range = r)]) ])) -> assertRange (3, 0) (5,11) r | _ -> Assert.Fail "Could not get valid AST" @@ -34,7 +34,7 @@ type MyRecord = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ - SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes)]) ])) -> + SynModuleOrNamespaceSig(decls = [SyncontentsigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes)]) ])) -> assertRange (2, 0) (4, 30) mTypes assertRange (2, 5) (4, 30) mSynTypeDefnSig | _ -> Assert.Fail "Could not get valid AST" @@ -51,7 +51,7 @@ type MyRecord = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ - SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes)]) ])) -> + SynModuleOrNamespaceSig(decls = [SyncontentsigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes)]) ])) -> assertRange (2, 0) (5, 30) mTypes assertRange (2, 5) (5, 30) mSynTypeDefnSig | _ -> Assert.Fail "Could not get valid AST" @@ -66,7 +66,7 @@ type MyFunction = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ - SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes) ]) ])) -> + SynModuleOrNamespaceSig(decls = [SyncontentsigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes) ]) ])) -> assertRange (2, 0) (3, 29) mTypes assertRange (2, 5) (3, 29) mSynTypeDefnSig | _ -> Assert.Fail "Could not get valid AST" @@ -82,7 +82,7 @@ type SomeCollection with match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ - SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes)]) ])) -> + SynModuleOrNamespaceSig(decls = [SyncontentsigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes)]) ])) -> assertRange (2, 0) (4, 37) mTypes assertRange (2, 5) (4, 37) mSynTypeDefnSig | _ -> Assert.Fail "Could not get valid AST" @@ -102,7 +102,7 @@ type MyType = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ - SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types(types = [SynTypeDefnSig.SynTypeDefnSig(range = r)]) as t]) ])) -> + SynModuleOrNamespaceSig(decls = [SyncontentsigDecl.Types(types = [SynTypeDefnSig.SynTypeDefnSig(range = r)]) as t]) ])) -> assertRange (4, 0) (7, 7) r assertRange (4, 0) (7, 7) t.Range | _ -> Assert.Fail "Could not get valid AST" @@ -127,7 +127,7 @@ and [] Bang = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ - SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types([ + SynModuleOrNamespaceSig(decls = [SyncontentsigDecl.Types([ SynTypeDefnSig.SynTypeDefnSig(range = r1) SynTypeDefnSig.SynTypeDefnSig(range = r2) ], mTypes)]) ])) -> @@ -151,7 +151,7 @@ type FooType = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = - [ SynModuleSigDecl.Types(types = [ + [ SyncontentsigDecl.Types(types = [ SynTypeDefnSig.SynTypeDefnSig(typeRepr = SynTypeDefnSigRepr.ObjectModel(memberSigs = [ SynMemberSig.Member(range = mr; memberSig = SynValSig(range = mv)) ])) @@ -172,7 +172,7 @@ type X = delegate of string -> string match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ - SynModuleSigDecl.Types( + SyncontentsigDecl.Types( types = [ SynTypeDefnSig(trivia = { EqualsRange = Some mEquals } typeRepr = SynTypeDefnSigRepr.ObjectModel(kind = SynTypeDefnKind.Delegate _)) ] ) @@ -194,7 +194,7 @@ type Foobar = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ - SynModuleSigDecl.Types( + SyncontentsigDecl.Types( types = [ SynTypeDefnSig(trivia = { EqualsRange = Some mEquals } typeRepr = SynTypeDefnSigRepr.ObjectModel(kind = SynTypeDefnKind.Class)) ] ) @@ -216,7 +216,7 @@ type Bear = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ - SynModuleSigDecl.Types( + SyncontentsigDecl.Types( types = [ SynTypeDefnSig(trivia = { EqualsRange = Some mEquals } typeRepr = SynTypeDefnSigRepr.Simple(repr = SynTypeDefnSimpleRepr.Enum(cases = [ @@ -244,7 +244,7 @@ type Shape = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ - SynModuleSigDecl.Types( + SyncontentsigDecl.Types( types = [ SynTypeDefnSig(trivia = { EqualsRange = Some mEquals } typeRepr = SynTypeDefnSigRepr.Simple(repr = SynTypeDefnSimpleRepr.Union _)) ] ) @@ -265,7 +265,7 @@ member Meh : unit -> unit match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents =[ SynModuleOrNamespaceSig(decls =[ - SynModuleSigDecl.Types( + SyncontentsigDecl.Types( types=[ SynTypeDefnSig(typeRepr=SynTypeDefnSigRepr.Simple _ trivia = { WithKeyword = Some mWithKeyword }) ] ) @@ -286,7 +286,7 @@ member Meh : unit -> unit match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ - SynModuleSigDecl.Exception( + SyncontentsigDecl.Exception( exnSig=SynExceptionSig(withKeyword = Some mWithKeyword) ) ]) ])) -> @@ -306,7 +306,7 @@ type Foo = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ - SynModuleSigDecl.Types( + SyncontentsigDecl.Types( types=[ SynTypeDefnSig(typeRepr=SynTypeDefnSigRepr.ObjectModel(memberSigs=[SynMemberSig.Member(memberSig=SynValSig(trivia = { WithKeyword = Some mWithKeyword }))])) ] ) ]) ])) -> @@ -330,7 +330,7 @@ exception SyntaxError of obj * range: range match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ - SynModuleSigDecl.Exception( + SyncontentsigDecl.Exception( SynExceptionSig(exnRepr=SynExceptionDefnRepr(range=mSynExceptionDefnRepr); range=mSynExceptionSig), mException) ] ) ])) -> assertRange (5, 0) (6, 43) mSynExceptionDefnRepr @@ -339,7 +339,7 @@ exception SyntaxError of obj * range: range | _ -> Assert.Fail "Could not get valid AST" [] -let ``Range of members should be included in SynExceptionSig and SynModuleSigDecl.Exception`` () = +let ``Range of members should be included in SynExceptionSig and SyncontentsigDecl.Exception`` () = let parseResults = getParseResultsOfSignatureFile """ @@ -354,9 +354,9 @@ open Foo match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ - SynModuleSigDecl.Exception( + SyncontentsigDecl.Exception( SynExceptionSig(exnRepr=SynExceptionDefnRepr(range=mSynExceptionDefnRepr); range=mSynExceptionSig), mException) - SynModuleSigDecl.Open _ + SyncontentsigDecl.Open _ ] ) ])) -> assertRange (4, 0) (4, 43) mSynExceptionDefnRepr assertRange (4, 0) (5, 30) mSynExceptionSig @@ -378,7 +378,7 @@ val a : int match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ - SynModuleSigDecl.Val(valSig = SynValSig(trivia = { ValKeyword = Some mVal })) + SyncontentsigDecl.Val(valSig = SynValSig(trivia = { ValKeyword = Some mVal })) ] ) ])) -> assertRange (6, 0) (6, 3) mVal | _ -> Assert.Fail "Could not get valid AST" @@ -396,7 +396,7 @@ val a : int = 9 match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ - SynModuleSigDecl.Val(valSig = SynValSig(trivia = { EqualsRange = Some mEquals }); range = mVal) + SyncontentsigDecl.Val(valSig = SynValSig(trivia = { EqualsRange = Some mEquals }); range = mVal) ] ) ])) -> assertRange (4, 12) (4, 13) mEquals assertRange (4, 0) (4, 15) mVal @@ -416,7 +416,7 @@ type X = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ - SynModuleSigDecl.Types(types = [ + SyncontentsigDecl.Types(types = [ SynTypeDefnSig(typeRepr = SynTypeDefnSigRepr.ObjectModel(memberSigs = [ SynMemberSig.Member(memberSig = SynValSig(trivia = { EqualsRange = Some mEquals }); range = mMember) ])) @@ -450,15 +450,15 @@ type Z with match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ - SynModuleSigDecl.Types(types = [ + SyncontentsigDecl.Types(types = [ SynTypeDefnSig(trivia = { TypeKeyword = Some mType1 EqualsRange = Some mEq1 WithKeyword = None }) ]) - SynModuleSigDecl.Types(types = [ + SyncontentsigDecl.Types(types = [ SynTypeDefnSig(trivia = { TypeKeyword = Some mType2 EqualsRange = Some mEq2 WithKeyword = None }) ]) - SynModuleSigDecl.Types(types = [ + SyncontentsigDecl.Types(types = [ SynTypeDefnSig(trivia = { TypeKeyword = Some mType3 EqualsRange = None WithKeyword = Some mWith3 }) ]) @@ -485,9 +485,9 @@ val InferSynValData: """ match parseResults with - | ParsedInput.SigFile (ParsedSigFileInput (modules=[ + | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ - SynModuleSigDecl.Val(valSig = SynValSig(synType = + SyncontentsigDecl.Val(valSig = SynValSig(synType = SynType.Fun( argType = SynType.Tuple(path = [ diff --git a/tests/service/SyntaxTreeTests/UnionCaseTests.fs b/tests/service/SyntaxTreeTests/UnionCaseTests.fs index 29fc350cc0b..c40a3ecc232 100644 --- a/tests/service/SyntaxTreeTests/UnionCaseTests.fs +++ b/tests/service/SyntaxTreeTests/UnionCaseTests.fs @@ -147,7 +147,7 @@ type X = """ match parseResults with - | ParsedInput.ImplFile (ParsedImplFileInput(modules = [ + | ParsedInput.ImplFile (ParsedImplFileInput(contents = [ SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types(typeDefns = [ SynTypeDefn(typeRepr = SynTypeDefnRepr.Simple(simpleRepr = From e1cbfdcb0ef08d67466aa84ac74c27c4b03dc75d Mon Sep 17 00:00:00 2001 From: nojaf Date: Mon, 19 Sep 2022 08:23:19 +0200 Subject: [PATCH 31/33] Correct code after rebase --- src/Compiler/Driver/ParseAndCheckInputs.fs | 1 - src/Compiler/Driver/ParseAndCheckInputs.fsi | 1 - src/Compiler/Driver/fsc.fs | 2 +- 3 files changed, 1 insertion(+), 3 deletions(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index f378fe16dc1..00543bf723a 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -792,7 +792,6 @@ let ParseInputFiles lexResourceManager, sourceFiles, diagnosticsLogger: DiagnosticsLogger, - exiter: Exiter, retryLocked ) = try diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index 69e13d79430..166191d363e 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -102,7 +102,6 @@ val ParseInputFiles: lexResourceManager: Lexhelp.LexResourceManager * sourceFiles: string list * diagnosticsLogger: DiagnosticsLogger * - exiter: Exiter * retryLocked: bool -> (ParsedInput * string) list diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 3a7298714f0..7b8e968814f 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -596,7 +596,7 @@ let main1 use unwindParsePhase = UseBuildPhase BuildPhase.Parse let inputs = - ParseInputFiles(tcConfig, lexResourceManager, sourceFiles, diagnosticsLogger, exiter, false) + ParseInputFiles(tcConfig, lexResourceManager, sourceFiles, diagnosticsLogger, false) let inputs, _ = (Map.empty, inputs) From ae4fe969003cfa16e5b82b9a45e6c5a1b128523c Mon Sep 17 00:00:00 2001 From: nojaf Date: Mon, 19 Sep 2022 08:58:13 +0200 Subject: [PATCH 32/33] Correct SynModuleSigDecl in SignatureTypeTests.fs --- .../SyntaxTreeTests/SignatureTypeTests.fs | 52 +++++++++---------- 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/tests/service/SyntaxTreeTests/SignatureTypeTests.fs b/tests/service/SyntaxTreeTests/SignatureTypeTests.fs index 4918518de32..7532e835ca2 100644 --- a/tests/service/SyntaxTreeTests/SignatureTypeTests.fs +++ b/tests/service/SyntaxTreeTests/SignatureTypeTests.fs @@ -19,7 +19,7 @@ type Meh = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ - SynModuleOrNamespaceSig(decls = [SyncontentsigDecl.Types(range = r)]) ])) -> + SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types(range = r)]) ])) -> assertRange (3, 0) (5,11) r | _ -> Assert.Fail "Could not get valid AST" @@ -34,7 +34,7 @@ type MyRecord = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ - SynModuleOrNamespaceSig(decls = [SyncontentsigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes)]) ])) -> + SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes)]) ])) -> assertRange (2, 0) (4, 30) mTypes assertRange (2, 5) (4, 30) mSynTypeDefnSig | _ -> Assert.Fail "Could not get valid AST" @@ -51,7 +51,7 @@ type MyRecord = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ - SynModuleOrNamespaceSig(decls = [SyncontentsigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes)]) ])) -> + SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes)]) ])) -> assertRange (2, 0) (5, 30) mTypes assertRange (2, 5) (5, 30) mSynTypeDefnSig | _ -> Assert.Fail "Could not get valid AST" @@ -66,7 +66,7 @@ type MyFunction = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ - SynModuleOrNamespaceSig(decls = [SyncontentsigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes) ]) ])) -> + SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes) ]) ])) -> assertRange (2, 0) (3, 29) mTypes assertRange (2, 5) (3, 29) mSynTypeDefnSig | _ -> Assert.Fail "Could not get valid AST" @@ -82,7 +82,7 @@ type SomeCollection with match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ - SynModuleOrNamespaceSig(decls = [SyncontentsigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes)]) ])) -> + SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types([SynTypeDefnSig.SynTypeDefnSig(range=mSynTypeDefnSig)], mTypes)]) ])) -> assertRange (2, 0) (4, 37) mTypes assertRange (2, 5) (4, 37) mSynTypeDefnSig | _ -> Assert.Fail "Could not get valid AST" @@ -102,7 +102,7 @@ type MyType = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ - SynModuleOrNamespaceSig(decls = [SyncontentsigDecl.Types(types = [SynTypeDefnSig.SynTypeDefnSig(range = r)]) as t]) ])) -> + SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types(types = [SynTypeDefnSig.SynTypeDefnSig(range = r)]) as t]) ])) -> assertRange (4, 0) (7, 7) r assertRange (4, 0) (7, 7) t.Range | _ -> Assert.Fail "Could not get valid AST" @@ -127,7 +127,7 @@ and [] Bang = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ - SynModuleOrNamespaceSig(decls = [SyncontentsigDecl.Types([ + SynModuleOrNamespaceSig(decls = [SynModuleSigDecl.Types([ SynTypeDefnSig.SynTypeDefnSig(range = r1) SynTypeDefnSig.SynTypeDefnSig(range = r2) ], mTypes)]) ])) -> @@ -151,7 +151,7 @@ type FooType = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = - [ SyncontentsigDecl.Types(types = [ + [ SynModuleSigDecl.Types(types = [ SynTypeDefnSig.SynTypeDefnSig(typeRepr = SynTypeDefnSigRepr.ObjectModel(memberSigs = [ SynMemberSig.Member(range = mr; memberSig = SynValSig(range = mv)) ])) @@ -172,7 +172,7 @@ type X = delegate of string -> string match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ - SyncontentsigDecl.Types( + SynModuleSigDecl.Types( types = [ SynTypeDefnSig(trivia = { EqualsRange = Some mEquals } typeRepr = SynTypeDefnSigRepr.ObjectModel(kind = SynTypeDefnKind.Delegate _)) ] ) @@ -194,7 +194,7 @@ type Foobar = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ - SyncontentsigDecl.Types( + SynModuleSigDecl.Types( types = [ SynTypeDefnSig(trivia = { EqualsRange = Some mEquals } typeRepr = SynTypeDefnSigRepr.ObjectModel(kind = SynTypeDefnKind.Class)) ] ) @@ -216,7 +216,7 @@ type Bear = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ - SyncontentsigDecl.Types( + SynModuleSigDecl.Types( types = [ SynTypeDefnSig(trivia = { EqualsRange = Some mEquals } typeRepr = SynTypeDefnSigRepr.Simple(repr = SynTypeDefnSimpleRepr.Enum(cases = [ @@ -244,7 +244,7 @@ type Shape = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ - SyncontentsigDecl.Types( + SynModuleSigDecl.Types( types = [ SynTypeDefnSig(trivia = { EqualsRange = Some mEquals } typeRepr = SynTypeDefnSigRepr.Simple(repr = SynTypeDefnSimpleRepr.Union _)) ] ) @@ -265,7 +265,7 @@ member Meh : unit -> unit match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents =[ SynModuleOrNamespaceSig(decls =[ - SyncontentsigDecl.Types( + SynModuleSigDecl.Types( types=[ SynTypeDefnSig(typeRepr=SynTypeDefnSigRepr.Simple _ trivia = { WithKeyword = Some mWithKeyword }) ] ) @@ -286,7 +286,7 @@ member Meh : unit -> unit match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ - SyncontentsigDecl.Exception( + SynModuleSigDecl.Exception( exnSig=SynExceptionSig(withKeyword = Some mWithKeyword) ) ]) ])) -> @@ -306,7 +306,7 @@ type Foo = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents = [ SynModuleOrNamespaceSig(decls = [ - SyncontentsigDecl.Types( + SynModuleSigDecl.Types( types=[ SynTypeDefnSig(typeRepr=SynTypeDefnSigRepr.ObjectModel(memberSigs=[SynMemberSig.Member(memberSig=SynValSig(trivia = { WithKeyword = Some mWithKeyword }))])) ] ) ]) ])) -> @@ -330,7 +330,7 @@ exception SyntaxError of obj * range: range match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ - SyncontentsigDecl.Exception( + SynModuleSigDecl.Exception( SynExceptionSig(exnRepr=SynExceptionDefnRepr(range=mSynExceptionDefnRepr); range=mSynExceptionSig), mException) ] ) ])) -> assertRange (5, 0) (6, 43) mSynExceptionDefnRepr @@ -339,7 +339,7 @@ exception SyntaxError of obj * range: range | _ -> Assert.Fail "Could not get valid AST" [] -let ``Range of members should be included in SynExceptionSig and SyncontentsigDecl.Exception`` () = +let ``Range of members should be included in SynExceptionSig and SynModuleSigDecl.Exception`` () = let parseResults = getParseResultsOfSignatureFile """ @@ -354,9 +354,9 @@ open Foo match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ - SyncontentsigDecl.Exception( + SynModuleSigDecl.Exception( SynExceptionSig(exnRepr=SynExceptionDefnRepr(range=mSynExceptionDefnRepr); range=mSynExceptionSig), mException) - SyncontentsigDecl.Open _ + SynModuleSigDecl.Open _ ] ) ])) -> assertRange (4, 0) (4, 43) mSynExceptionDefnRepr assertRange (4, 0) (5, 30) mSynExceptionSig @@ -378,7 +378,7 @@ val a : int match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ - SyncontentsigDecl.Val(valSig = SynValSig(trivia = { ValKeyword = Some mVal })) + SynModuleSigDecl.Val(valSig = SynValSig(trivia = { ValKeyword = Some mVal })) ] ) ])) -> assertRange (6, 0) (6, 3) mVal | _ -> Assert.Fail "Could not get valid AST" @@ -396,7 +396,7 @@ val a : int = 9 match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ - SyncontentsigDecl.Val(valSig = SynValSig(trivia = { EqualsRange = Some mEquals }); range = mVal) + SynModuleSigDecl.Val(valSig = SynValSig(trivia = { EqualsRange = Some mEquals }); range = mVal) ] ) ])) -> assertRange (4, 12) (4, 13) mEquals assertRange (4, 0) (4, 15) mVal @@ -416,7 +416,7 @@ type X = match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ - SyncontentsigDecl.Types(types = [ + SynModuleSigDecl.Types(types = [ SynTypeDefnSig(typeRepr = SynTypeDefnSigRepr.ObjectModel(memberSigs = [ SynMemberSig.Member(memberSig = SynValSig(trivia = { EqualsRange = Some mEquals }); range = mMember) ])) @@ -450,15 +450,15 @@ type Z with match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ - SyncontentsigDecl.Types(types = [ + SynModuleSigDecl.Types(types = [ SynTypeDefnSig(trivia = { TypeKeyword = Some mType1 EqualsRange = Some mEq1 WithKeyword = None }) ]) - SyncontentsigDecl.Types(types = [ + SynModuleSigDecl.Types(types = [ SynTypeDefnSig(trivia = { TypeKeyword = Some mType2 EqualsRange = Some mEq2 WithKeyword = None }) ]) - SyncontentsigDecl.Types(types = [ + SynModuleSigDecl.Types(types = [ SynTypeDefnSig(trivia = { TypeKeyword = Some mType3 EqualsRange = None WithKeyword = Some mWith3 }) ]) @@ -487,7 +487,7 @@ val InferSynValData: match parseResults with | ParsedInput.SigFile (ParsedSigFileInput (contents=[ SynModuleOrNamespaceSig(decls=[ - SyncontentsigDecl.Val(valSig = SynValSig(synType = + SynModuleSigDecl.Val(valSig = SynValSig(synType = SynType.Fun( argType = SynType.Tuple(path = [ From a19238ec7451b4c0a5f4f67909b2026e2acfdb0a Mon Sep 17 00:00:00 2001 From: nojaf Date: Mon, 19 Sep 2022 09:27:14 +0200 Subject: [PATCH 33/33] Format ParseAndCheckInputs.fs --- src/Compiler/Driver/ParseAndCheckInputs.fs | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 00543bf723a..703e3483f10 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -786,14 +786,7 @@ let ParseInputFilesSequential (tcConfig: TcConfig, lexResourceManager, sourceFil |> List.ofArray /// Parse multiple input files from disk -let ParseInputFiles - ( - tcConfig: TcConfig, - lexResourceManager, - sourceFiles, - diagnosticsLogger: DiagnosticsLogger, - retryLocked - ) = +let ParseInputFiles (tcConfig: TcConfig, lexResourceManager, sourceFiles, diagnosticsLogger: DiagnosticsLogger, retryLocked) = try if tcConfig.concurrentBuild then ParseInputFilesInParallel(tcConfig, lexResourceManager, sourceFiles, diagnosticsLogger, retryLocked)