Consolidating code around process exiting

src/Compiler/Driver/CompilerConfig.fs

@@ -577,6 +577,8 @@ type TcConfigBuilder =
         mutable langVersion: LanguageVersion
 
         mutable xmlDocInfoLoader: IXmlDocumentationInfoLoader option
+
+        mutable exiter: Exiter
     }
 
     // Directories to start probing in
@@ -762,6 +764,7 @@ type TcConfigBuilder =
             rangeForErrors = rangeForErrors
             sdkDirOverride = sdkDirOverride
             xmlDocInfoLoader = None
+            exiter = QuitProcessExiter
         }
 
     member tcConfigB.FxResolver =
@@ -1303,6 +1306,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) =
     member _.noConditionalErasure = data.noConditionalErasure
     member _.applyLineDirectives = data.applyLineDirectives
     member _.xmlDocInfoLoader = data.xmlDocInfoLoader
+    member _.exiter = data.exiter
 
     static member Create(builder, validate) =
         use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter

src/Compiler/Driver/CompilerConfig.fsi

@@ -478,6 +478,8 @@ type TcConfigBuilder =
         mutable langVersion: LanguageVersion
 
         mutable xmlDocInfoLoader: IXmlDocumentationInfoLoader option
+
+        mutable exiter: Exiter
     }
 
     static member CreateNew:
@@ -837,6 +839,8 @@ type TcConfig =
     /// Check if the primary assembly is mscorlib
     member assumeDotNetFramework: bool
 
+    member exiter: Exiter
+
 /// Represents a computation to return a TcConfig. Normally this is just a constant immutable TcConfig,
 /// but for F# Interactive it may be based on an underlying mutable TcConfigBuilder.
 [<Sealed>]

src/Compiler/Driver/CompilerOptions.fs

@@ -1137,7 +1137,7 @@ let languageFlags tcConfigB =
             tagNone,
             OptionConsoleOnly(fun _ ->
                 Console.Write(GetLanguageVersions())
-                exit 0),
+                tcConfigB.exiter.Exit 0),
             None,
             Some(FSComp.SR.optsGetLangVersions ())
         )
@@ -2035,7 +2035,7 @@ let miscFlagsBoth tcConfigB =
             tagNone,
             OptionConsoleOnly(fun _ ->
                 Console.Write(GetVersion tcConfigB)
-                exit 0),
+                tcConfigB.exiter.Exit 0),
             None,
             Some(FSComp.SR.optsVersion ())
         )
@@ -2049,7 +2049,7 @@ let miscFlagsFsc tcConfigB =
             tagNone,
             OptionConsoleOnly(fun blocks ->
                 Console.Write(GetHelpFsc tcConfigB blocks)
-                exit 0),
+                tcConfigB.exiter.Exit 0),
             None,
             Some(FSComp.SR.optsHelp ())
         )
@@ -2110,7 +2110,7 @@ let abbreviatedFlagsFsc tcConfigB =
             tagNone,
             OptionConsoleOnly(fun blocks ->
                 Console.Write(GetHelpFsc tcConfigB blocks)
-                exit 0),
+                tcConfigB.exiter.Exit 0),
             None,
             Some(FSComp.SR.optsShortFormOf ("--help"))
         )
@@ -2120,7 +2120,7 @@ let abbreviatedFlagsFsc tcConfigB =
             tagNone,
             OptionConsoleOnly(fun blocks ->
                 Console.Write(GetHelpFsc tcConfigB blocks)
-                exit 0),
+                tcConfigB.exiter.Exit 0),
             None,
             Some(FSComp.SR.optsShortFormOf ("--help"))
         )
@@ -2130,7 +2130,7 @@ let abbreviatedFlagsFsc tcConfigB =
             tagNone,
             OptionConsoleOnly(fun blocks ->
                 Console.Write(GetHelpFsc tcConfigB blocks)
-                exit 0),
+                tcConfigB.exiter.Exit 0),
             None,
             Some(FSComp.SR.optsShortFormOf ("--help"))
         )

src/Compiler/Driver/ParseAndCheckInputs.fs

@@ -471,27 +471,27 @@ let ParseInput
 type Tokenizer = unit -> Parser.token
 
 // Show all tokens in the stream, for testing purposes
-let ShowAllTokensAndExit (shortFilename, tokenizer: Tokenizer, lexbuf: LexBuffer<char>) =
+let ShowAllTokensAndExit (shortFilename, tokenizer: Tokenizer, lexbuf: LexBuffer<char>, exiter: Exiter) =
     while true do
         printf "tokenize - getting one token from %s\n" shortFilename
         let t = tokenizer ()
         printf "tokenize - got %s @ %a\n" (Parser.token_to_string t) outputRange lexbuf.LexemeRange
 
         match t with
-        | Parser.EOF _ -> exit 0
+        | Parser.EOF _ -> exiter.Exit 0
         | _ -> ()
 
         if lexbuf.IsPastEndOfStream then
             printf "!!! at end of stream\n"
 
 // Test one of the parser entry points, just for testing purposes
-let TestInteractionParserAndExit (tokenizer: Tokenizer, lexbuf: LexBuffer<char>) =
+let TestInteractionParserAndExit (tokenizer: Tokenizer, lexbuf: LexBuffer<char>, exiter: Exiter) =
     while true do
         match (Parser.interaction (fun _ -> tokenizer ()) lexbuf) with
         | ParsedScriptInteraction.Definitions (l, m) -> printfn "Parsed OK, got %d defs @ %a" l.Length outputRange m
         | ParsedScriptInteraction.HashDirective (_, m) -> printfn "Parsed OK, got hash @ %a" outputRange m
 
-    exit 0
+    exiter.Exit 0
 
 // Report the statistics for testing purposes
 let ReportParsingStatistics res =
@@ -606,11 +606,11 @@ let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, lexbuf, fileNam
 
                 // If '--tokenize' then show the tokens now and exit
                 if tokenizeOnly then
-                    ShowAllTokensAndExit(shortFilename, tokenizer, lexbuf)
+                    ShowAllTokensAndExit(shortFilename, tokenizer, lexbuf, tcConfig.exiter)
 
                 // Test hook for one of the parser entry points
                 if tcConfig.testInteractionParser then
-                    TestInteractionParserAndExit(tokenizer, lexbuf)
+                    TestInteractionParserAndExit(tokenizer, lexbuf, tcConfig.exiter)
 
                 // Parse the input
                 let res =
@@ -741,7 +741,6 @@ let ParseInputFiles
         lexResourceManager,
         sourceFiles,
         diagnosticsLogger: DiagnosticsLogger,
-        exiter: Exiter,
         createDiagnosticsLogger: Exiter -> CapturingDiagnosticsLogger,
         retryLocked
     ) =
@@ -764,7 +763,7 @@ let ParseInputFiles
                 sourceFiles
                 |> Array.map (fun (fileName, _) ->
                     checkInputFile tcConfig fileName
-                    createDiagnosticsLogger (delayedExiter))
+                    createDiagnosticsLogger delayedExiter)
 
             let results =
                 try
@@ -790,7 +789,7 @@ let ParseInputFiles
                         delayedDiagnosticsLoggers
                         |> Array.iter (fun delayedDiagnosticsLogger -> delayedDiagnosticsLogger.CommitDelayedDiagnostics diagnosticsLogger)
                 with StopProcessing ->
-                    exiter.Exit exitCode
+                    tcConfig.exiter.Exit exitCode
 
             results |> List.ofArray
         else
@@ -806,7 +805,7 @@ let ParseInputFiles
 
     with e ->
         errorRecoveryNoRange e
-        exiter.Exit 1
+        tcConfig.exiter.Exit 1
 
 let ProcessMetaCommandsFromInput
     (nowarnF: 'state -> range * string -> 'state,

src/Compiler/Driver/ParseAndCheckInputs.fsi

@@ -104,7 +104,6 @@ val ParseInputFiles:
     lexResourceManager: Lexhelp.LexResourceManager *
     sourceFiles: string list *
     diagnosticsLogger: DiagnosticsLogger *
-    exiter: Exiter *
     createDiagnosticsLogger: (Exiter -> CapturingDiagnosticsLogger) *
     retryLocked: bool ->
         (ParsedInput * string) list

src/Compiler/Driver/fsc.fs

@@ -510,6 +510,8 @@ let main1
             rangeForErrors = range0
         )
 
+    tcConfigB.exiter <- exiter
+
     // Preset: --optimize+ -g --tailcalls+ (see 4505)
     SetOptimizeSwitch tcConfigB OptionSwitch.On
     SetDebugSwitch tcConfigB None OptionSwitch.Off
@@ -609,7 +611,7 @@ let main1
         (fun exiter -> diagnosticsLoggerProvider.CreateDelayAndForwardLogger(exiter) :> CapturingDiagnosticsLogger)
 
     let inputs =
-        ParseInputFiles(tcConfig, lexResourceManager, sourceFiles, diagnosticsLogger, exiter, createDiagnosticsLogger, false)
+        ParseInputFiles(tcConfig, lexResourceManager, sourceFiles, diagnosticsLogger, createDiagnosticsLogger, false)
 
     let inputs, _ =
         (Map.empty, inputs)

src/fsc/fscmain.fs

@@ -72,19 +72,6 @@ let main (argv) =
                     stats.rawMemoryFileCount
                     stats.weakByteFileCount)
 
-        // This object gets invoked when two many errors have been accumulated, or an abort-on-error condition
-        // has been reached (e.g. type checking failed, so don't proceed to optimization).
-        let quitProcessExiter =
-            { new Exiter with
-                member _.Exit(n) =
-                    try
-                        exit n
-                    with _ ->
-                        ()
-
-                    failwithf "%s" (FSComp.SR.elSysEnvExitDidntExit ())
-            }
-
         // Get the handler for legacy resolution of references via MSBuild.
         let legacyReferenceResolver = LegacyMSBuildReferenceResolver.getResolver ()
 
@@ -101,7 +88,7 @@ let main (argv) =
             false,
             ReduceMemoryFlag.No,
             CopyFSharpCoreFlag.Yes,
-            quitProcessExiter,
+            QuitProcessExiter,
             ConsoleLoggerProvider(),
             None,
             None