12322: Fix deep recursive expression processing (#12420)

docs/large-inputs-and-stack-overflows.md

@@ -21,6 +21,13 @@ The compiler performs constant folding for large constants so there are no costs
 
 Many sources of `StackOverflow` exceptions prior to F# 4.7 when processing these kinds of constructs were resolved by processing them on the heap via continuation passing techniques. This avoids filling data on the stack and appears to have negligible effects on overall throughout or memory usage of the compiler.
 
+There are two techniques to deal with this
+
+1. Linearizing processing of specific input shapes, keeping stacks small
+2. Using stack guards to simply temporarily move to a new thread when a certain threshold is reached.
+
+## Linearizing processing if certain inputs
+
 Aside from array expressions, most of the previously-listed inputs are called "linear" expressions. This means that there is a single linear hole in the shape of expressions. For example:
 
 * `expr :: HOLE` (list expressions or other right-linear constructions)
@@ -80,3 +87,31 @@ Some common aspects of this style of programming are:
 
 The previous example is considered incomplete, because arbitrary _combinations_ of `let` and sequential expressions aren't going to be dealt with in a tail-recursive way. The compiler generally tries to do these combinations as well.
 
+## Stack Guards
+
+The `StackGuard` type is used to count synchronous recursive processing and move to a new thread if a limit is reached. Compilation globals are re-installed. Sample:
+
+```fsharp
+let TcStackGuardDepth = StackGuard.GetDepthOption "Tc"
+
+...
+   stackGuard = StackGuard(TcMaxStackGuardDepth)
+
+let rec ....
+
+and TcExpr cenv ty (env: TcEnv) tpenv (expr: SynExpr) =
+
+    // Guard the stack for deeply nested expressions
+    cenv.stackGuard.Guard <| fun () ->
+
+    ...
+
+```
+
+Note stack guarding doesn't result in a tailcall so will appear in recursive stack frames, because a counter must be decremented after the call. This is used systematically for recursive processing of:
+
+* SyntaxTree SynExpr
+* TypedTree Expr
+
+We don't use it for other inputs.
+

src/fsharp/BuildGraph.fs

@@ -10,22 +10,6 @@ open System.Globalization
 open FSharp.Compiler.ErrorLogger
 open Internal.Utilities.Library
 
-/// This represents the thread-local state established as each task function runs as part of the build.
-///
-/// Use to reset error and warning handlers.
-type CompilationGlobalsScope(errorLogger: ErrorLogger, phase: BuildPhase) = 
-    let unwindEL = PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger)
-    let unwindBP = PushThreadBuildPhaseUntilUnwind phase
-
-    member _.ErrorLogger = errorLogger
-    member _.Phase = phase
-
-    // Return the disposable object that cleans up
-    interface IDisposable with
-        member d.Dispose() =
-            unwindBP.Dispose()         
-            unwindEL.Dispose()
-
 [<NoEquality;NoComparison>]
 type NodeCode<'T> = Node of Async<'T>
 
@@ -89,7 +73,7 @@ type NodeCodeBuilder() =
         Node(
             async {
                 CompileThreadStatic.ErrorLogger <- value.ErrorLogger
-                CompileThreadStatic.BuildPhase <- value.Phase
+                CompileThreadStatic.BuildPhase <- value.BuildPhase
                 try
                     return! binder value |> Async.AwaitNodeCode
                 finally

src/fsharp/BuildGraph.fsi

@@ -8,13 +8,6 @@ open System.Threading.Tasks
 open FSharp.Compiler.ErrorLogger
 open Internal.Utilities.Library
 
-/// This represents the global state established as each task function runs as part of the build.
-///
-/// Use to reset error and warning handlers.
-type CompilationGlobalsScope =
-    new : ErrorLogger * BuildPhase -> CompilationGlobalsScope
-    interface IDisposable
-
 /// Represents code that can be run as part of the build graph.
 ///
 /// This is essentially cancellable async code where the only asynchronous waits are on nodes.

src/fsharp/CheckComputationExpressions.fs

@@ -760,6 +760,8 @@ let TcComputationExpression cenv env (overallTy: OverallTy) tpenv (mWhole, inter
     // translatedCtxt - represents the translation of the context in which the computation expression 'comp' occurs, up to a
     //                  hole to be filled by (part of) the results of translating 'comp'.
     let rec tryTrans firstTry q varSpace comp translatedCtxt =
+        // Guard the stack for deeply nested computation expressions
+        cenv.stackGuard.Guard <| fun () ->
 
         match comp with 
 

src/fsharp/CheckDeclarations.fs

@@ -42,6 +42,8 @@ open FSharp.Compiler.ExtensionTyping
 
 type cenv = TcFileState
 
+let TcClassRewriteStackGuardDepth = StackGuard.GetDepthOption "TcClassRewrite"
+
 //-------------------------------------------------------------------------
 // Mutually recursive shapes
 //------------------------------------------------------------------------- 
@@ -1144,8 +1146,8 @@ module IncrClassChecking =
             RewriteExpr { PreIntercept = Some FixupExprNode 
                           PostTransform = (fun _ -> None)
                           PreInterceptBinding = None
-                          IsUnderQuotations=true } expr 
-
+                          RewriteQuotations = true
+                          StackGuard = StackGuard(TcClassRewriteStackGuardDepth) } expr 
 
     type IncrClassConstructionBindingsPhase2C =
       | Phase2CBindings of IncrClassBindingGroup list

src/fsharp/CheckExpressions.fs

@@ -51,6 +51,12 @@ let mkNilListPat (g: TcGlobals) m ty = TPat_unioncase(g.nil_ucref, [ty], [], m)
 
 let mkConsListPat (g: TcGlobals) ty ph pt = TPat_unioncase(g.cons_ucref, [ty], [ph;pt], unionRanges ph.Range pt.Range)
 
+#if DEBUG
+let TcStackGuardDepth = GetEnvInteger "FSHARP_TcStackGuardDepth" 40
+#else
+let TcStackGuardDepth = GetEnvInteger "FSHARP_TcStackGuardDepth" 80
+#endif
+
 //-------------------------------------------------------------------------
 // Errors.
 //-------------------------------------------------------------------------
@@ -358,6 +364,9 @@ type TcFileState =
       /// we infer type parameters
       mutable recUses: ValMultiMap<Expr ref * range * bool>
 
+      /// Guard against depth of expression nesting, by moving to new stack when a maximum depth is reached
+      stackGuard: StackGuard
+
       /// Set to true if this file causes the creation of generated provided types.
       mutable createsGeneratedProvidedTypes: bool
 
@@ -421,6 +430,7 @@ type TcFileState =
         { g = g
           amap = amap
           recUses = ValMultiMap<_>.Empty
+          stackGuard = StackGuard(TcStackGuardDepth)
           createsGeneratedProvidedTypes = false
           topCcu = topCcu
           isScript = isScript
@@ -5359,7 +5369,11 @@ and TcExprFlex2 cenv desiredTy env isMethodArg tpenv synExpr =
     TcExpr cenv (MustConvertTo (isMethodArg, desiredTy)) env tpenv synExpr
 
 and TcExpr cenv ty (env: TcEnv) tpenv (expr: SynExpr) =
-    // Start an error recovery handler
+
+    // Guard the stack for deeply nested expressions
+    cenv.stackGuard.Guard <| fun () ->
+
+    // Start an error recovery handler, and check for stack recursion depth, moving to a new stack if necessary.
     // Note the try/with can lead to tail-recursion problems for iterated constructs, e.g. let... in...
     // So be careful!
     try

src/fsharp/CheckExpressions.fsi

@@ -10,6 +10,7 @@ open FSharp.Compiler.AbstractIL.IL
 open FSharp.Compiler.AccessibilityLogic
 open FSharp.Compiler.CompilerGlobalState
 open FSharp.Compiler.ConstraintSolver
+open FSharp.Compiler.ErrorLogger
 open FSharp.Compiler.Import
 open FSharp.Compiler.InfoReader
 open FSharp.Compiler.Infos
@@ -180,6 +181,9 @@ type TcFileState =
       /// we infer type parameters 
       mutable recUses: ValMultiMap<Expr ref * range * bool>
       
+      /// Guard against depth of expression nesting, by moving to new stack when a maximum depth is reached
+      stackGuard: StackGuard
+
       /// Set to true if this file causes the creation of generated provided types.
       mutable createsGeneratedProvidedTypes: bool
 

src/fsharp/CompilerDiagnostics.fs

@@ -1656,7 +1656,7 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) (canSuggestNa
           os.Append(TargetInvocationExceptionWrapperE().Format e.Message) |> ignore
 #if DEBUG
           Printf.bprintf os "\nStack Trace\n%s\n" (e.ToString())
-          if !showAssertForUnexpectedException then
+          if showAssertForUnexpectedException.Value then
               Debug.Assert(false, sprintf "Unknown exception seen in compiler: %s" (e.ToString()))
 #endif
 

src/fsharp/DetupleArgs.fs

@@ -5,13 +5,16 @@ module internal FSharp.Compiler.Detuple
 open Internal.Utilities.Collections
 open Internal.Utilities.Library 
 open Internal.Utilities.Library.Extras
-open FSharp.Compiler.TcGlobals
+open FSharp.Compiler.ErrorLogger
 open FSharp.Compiler.Syntax
+open FSharp.Compiler.TcGlobals
 open FSharp.Compiler.Text
-open FSharp.Compiler.Xml
 open FSharp.Compiler.TypedTree
 open FSharp.Compiler.TypedTreeBasics
 open FSharp.Compiler.TypedTreeOps
+open FSharp.Compiler.Xml
+
+let DetupleRewriteStackGuardDepth = StackGuard.GetDepthOption "DetupleRewrite"
 
 // This pass has one aim.
 // - to eliminate tuples allocated at call sites (due to uncurried style)
@@ -174,16 +177,23 @@ module GlobalUsageAnalysis =
     ///      where first accessor in list applies first to the v/app.
     ///   (b) log it's binding site representation.
     type Results =
-       { ///  v -> context / APP inst args 
+       {
+         ///  v -> context / APP inst args 
          Uses     : Zmap<Val, (accessor list * TType list * Expr list) list>
+
          /// v -> binding repr 
          Defns     : Zmap<Val, Expr>                                        
+
          /// bound in a decision tree? 
-         DecisionTreeBindings    : Zset<Val>                                    
+         DecisionTreeBindings: Zset<Val>                                    
+
          ///  v -> v list * recursive? -- the others in the mutual binding 
-         RecursiveBindings  : Zmap<Val, bool * Vals>
-         TopLevelBindings : Zset<Val>
-         IterationIsAtTopLevel      : bool }
+         RecursiveBindings: Zmap<Val, bool * Vals>
+
+         TopLevelBindings: Zset<Val>
+
+         IterationIsAtTopLevel: bool
+       }
 
     let z0 =
        { Uses     = Zmap.empty valOrder
@@ -841,10 +851,13 @@ let postTransformExpr (penv: penv) expr =
     | _ -> None
   
 let passImplFile penv assembly = 
-    assembly |> RewriteImplFile { PreIntercept =None
-                                  PreInterceptBinding=None
-                                  PostTransform= postTransformExpr penv
-                                  IsUnderQuotations=false } 
+    let rwenv =
+        { PreIntercept = None
+          PreInterceptBinding = None
+          PostTransform = postTransformExpr penv
+          RewriteQuotations = false
+          StackGuard = StackGuard(DetupleRewriteStackGuardDepth) } 
+    assembly |> RewriteImplFile rwenv
 
 //-------------------------------------------------------------------------
 // entry point

src/fsharp/ErrorLogger.fs

@@ -8,6 +8,9 @@ open FSharp.Compiler.Text.Range
 open FSharp.Compiler.Text
 open System
 open System.Diagnostics
+open System.Threading
+open Internal.Utilities.Library
+open Internal.Utilities.Library.Extras
 
 /// Represents the style being used to format errors
 [<RequireQualifiedAccess>]
@@ -433,33 +436,38 @@ module ErrorLoggerExtensions =
 /// NOTE: The change will be undone when the returned "unwind" object disposes
 let PushThreadBuildPhaseUntilUnwind (phase:BuildPhase) =
     let oldBuildPhase = CompileThreadStatic.BuildPhaseUnchecked
-    
     CompileThreadStatic.BuildPhase <- phase
-
     { new IDisposable with 
-         member x.Dispose() = CompileThreadStatic.BuildPhase <- oldBuildPhase (* maybe null *) }
+         member x.Dispose() = CompileThreadStatic.BuildPhase <- oldBuildPhase }
 
 /// NOTE: The change will be undone when the returned "unwind" object disposes
-let PushErrorLoggerPhaseUntilUnwind(errorLoggerTransformer : ErrorLogger -> #ErrorLogger) =
+let PushErrorLoggerPhaseUntilUnwind(errorLoggerTransformer: ErrorLogger -> #ErrorLogger) =
     let oldErrorLogger = CompileThreadStatic.ErrorLogger
-    let newErrorLogger = errorLoggerTransformer oldErrorLogger
-    let mutable newInstalled = true
-    let newIsInstalled() = if newInstalled then () else (assert false; (); (*failwith "error logger used after unwind"*)) // REVIEW: ok to throw?
-    let chkErrorLogger = { new ErrorLogger("PushErrorLoggerPhaseUntilUnwind") with
-                             member _.DiagnosticSink(phasedError, isError) = newIsInstalled(); newErrorLogger.DiagnosticSink(phasedError, isError)
-                             member _.ErrorCount = newIsInstalled(); newErrorLogger.ErrorCount }
-
-    CompileThreadStatic.ErrorLogger <- chkErrorLogger
-
+    CompileThreadStatic.ErrorLogger <- errorLoggerTransformer oldErrorLogger
     { new IDisposable with 
          member _.Dispose() =
-            CompileThreadStatic.ErrorLogger <- oldErrorLogger
-            newInstalled <- false }
+            CompileThreadStatic.ErrorLogger <- oldErrorLogger }
 
 let SetThreadBuildPhaseNoUnwind(phase:BuildPhase) = CompileThreadStatic.BuildPhase <- phase
 
 let SetThreadErrorLoggerNoUnwind errorLogger     = CompileThreadStatic.ErrorLogger <- errorLogger
 
+/// This represents the thread-local state established as each task function runs as part of the build.
+///
+/// Use to reset error and warning handlers.
+type CompilationGlobalsScope(errorLogger: ErrorLogger, buildPhase: BuildPhase) = 
+    let unwindEL = PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger)
+    let unwindBP = PushThreadBuildPhaseUntilUnwind buildPhase
+
+    member _.ErrorLogger = errorLogger
+    member _.BuildPhase = buildPhase
+
+    // Return the disposable object that cleans up
+    interface IDisposable with
+        member _.Dispose() =
+            unwindBP.Dispose()         
+            unwindEL.Dispose()
+
 // Global functions are still used by parser and TAST ops.
 
 /// Raises an exception with error recovery and returns unit.
@@ -697,3 +705,36 @@ let internal languageFeatureNotSupportedInLibraryError (langVersion: LanguageVer
     let featureStr = langVersion.GetFeatureString langFeature
     let suggestedVersionStr = langVersion.GetFeatureVersionString langFeature
     error (Error(FSComp.SR.chkFeatureNotSupportedInLibrary(featureStr, suggestedVersionStr), m))
+
+/// Guard against depth of expression nesting, by moving to new stack when a maximum depth is reached
+type StackGuard(maxDepth: int) =
+
+    let mutable depth = 1
+
+    member _.Guard(f) =
+        depth <- depth + 1
+        try
+            if depth % maxDepth = 0 then 
+                let errorLogger = CompileThreadStatic.ErrorLogger
+                let buildPhase = CompileThreadStatic.BuildPhase
+                async { 
+                    do! Async.SwitchToNewThread()
+                    Thread.CurrentThread.Name <- "F# Extra Compilation Thread"
+                    use _scope = new CompilationGlobalsScope(errorLogger, buildPhase)
+                    return f()
+                } |> Async.RunImmediate
+            else
+                f()
+        finally
+            depth <- depth - 1
+
+    static member val DefaultDepth =
+#if DEBUG
+        GetEnvInteger "FSHARP_DefaultStackGuardDepth" 50
+#else
+        GetEnvInteger "FSHARP_DefaultStackGuardDepth" 100
+#endif
+
+    static member GetDepthOption (name: string) = 
+        GetEnvInteger ("FSHARP_" + name + "StackGuardDepth") StackGuard.DefaultDepth
+

src/fsharp/ErrorLogger.fsi

@@ -338,3 +338,24 @@ val checkLanguageFeatureErrorRecover: langVersion:LanguageVersion -> langFeature
 val tryLanguageFeatureErrorOption: langVersion:LanguageVersion -> langFeature:LanguageFeature -> m:range -> exn option
 
 val languageFeatureNotSupportedInLibraryError: langVersion:LanguageVersion -> langFeature:LanguageFeature -> m:range -> 'a
+
+type StackGuard =
+    new: maxDepth: int -> StackGuard
+
+    /// Execute the new function, on a new thread if necessary
+    member Guard: f: (unit -> 'T) -> 'T
+
+    static member GetDepthOption: string -> int
+
+/// This represents the global state established as each task function runs as part of the build.
+///
+/// Use to reset error and warning handlers.
+type CompilationGlobalsScope =
+    new: errorLogger: ErrorLogger * buildPhase: BuildPhase -> CompilationGlobalsScope
+
+    interface IDisposable
+
+    member ErrorLogger: ErrorLogger
+
+    member BuildPhase: BuildPhase
+

src/fsharp/FindUnsolved.fs

@@ -5,7 +5,9 @@ module internal FSharp.Compiler.FindUnsolved
 
 open Internal.Utilities.Collections
 open Internal.Utilities.Library
+open Internal.Utilities.Library.Extras
 open FSharp.Compiler
+open FSharp.Compiler.ErrorLogger
 open FSharp.Compiler.TypedTree
 open FSharp.Compiler.TypedTreeBasics
 open FSharp.Compiler.TypedTreeOps
@@ -14,12 +16,15 @@ open FSharp.Compiler.TypeRelations
 
 type env = Nix
 
+let FindUnsolvedStackGuardDepth = StackGuard.GetDepthOption "FindUnsolved"
+
 /// The environment and collector
 type cenv = 
     { g: TcGlobals 
       amap: Import.ImportMap 
       denv: DisplayEnv 
-      mutable unsolved: Typars }
+      mutable unsolved: Typars 
+      stackGuard: StackGuard }
 
     override x.ToString() = "<cenv>"
 
@@ -34,7 +39,9 @@ let accTypeInst cenv env tyargs =
     tyargs |> List.iter (accTy cenv env)
 
 /// Walk expressions, collecting type variables
-let rec accExpr   (cenv:cenv) (env:env) expr =     
+let rec accExpr (cenv:cenv) (env:env) expr =     
+    cenv.stackGuard.Guard <| fun () ->
+
     let expr = stripExpr expr 
     match expr with
     | Expr.Sequential (e1, e2, _, _, _) -> 
@@ -278,7 +285,8 @@ let UnsolvedTyparsOfModuleDef g amap denv (mdef, extraAttribs) =
       { g =g  
         amap=amap 
         denv=denv 
-        unsolved = [] }
+        unsolved = [] 
+        stackGuard = StackGuard(FindUnsolvedStackGuardDepth) }
    accModuleOrNamespaceDef cenv Nix mdef
    accAttribs cenv Nix extraAttribs
    List.rev cenv.unsolved

src/fsharp/IlxGen.fs

@@ -40,6 +40,8 @@ open FSharp.Compiler.TypedTreeOps
 open FSharp.Compiler.TypedTreeOps.DebugPrint
 open FSharp.Compiler.TypeRelations
 
+let IlxGenStackGuardDepth = StackGuard.GetDepthOption "IlxGen"
+
 let IsNonErasedTypar (tp: Typar) =
     not tp.IsErased
 
@@ -255,14 +257,12 @@ type cenv =
       /// Used to apply forced inlining optimizations to witnesses generated late during codegen
       mutable optimizeDuringCodeGen: bool -> Expr -> Expr
 
-      /// What depth are we at when generating an expression?
-      mutable exprRecursionDepth: int
+      /// Guard the stack and move to a new one if necessary
+      mutable stackGuard: StackGuard
 
-      /// Delayed Method Generation - prevents stack overflows when we need to generate methods that are split into many methods by the optimizer.
-      delayedGenMethods: Queue<cenv -> unit>
     }
 
-    override x.ToString() = "<cenv>"
+    override _.ToString() = "<cenv>"
 
 
 let mkTypeOfExpr cenv m ilty =
@@ -2479,32 +2479,9 @@ let ProcessDebugPointForExpr (cenv: cenv) (cgbuf: CodeGenBuffer) sp expr =
 //-------------------------------------------------------------------------
 
 let rec GenExpr cenv cgbuf eenv sp (expr: Expr) sequel =
-    cenv.exprRecursionDepth <- cenv.exprRecursionDepth + 1
-
-    if cenv.exprRecursionDepth > 1 then
-        StackGuard.EnsureSufficientExecutionStack cenv.exprRecursionDepth
-        GenExprAux cenv cgbuf eenv sp expr sequel
-    else
-        GenExprWithStackGuard cenv cgbuf eenv sp expr sequel
-
-    cenv.exprRecursionDepth <- cenv.exprRecursionDepth - 1
-
-    if cenv.exprRecursionDepth = 0 then
-        ProcessDelayedGenMethods cenv
+    cenv.stackGuard.Guard <| fun () ->
 
-and ProcessDelayedGenMethods cenv =
-    while cenv.delayedGenMethods.Count > 0 do
-        let gen = cenv.delayedGenMethods.Dequeue ()
-        gen cenv
-
-and GenExprWithStackGuard cenv cgbuf eenv sp expr sequel =
-    assert (cenv.exprRecursionDepth = 1)
-    try
-        GenExprAux cenv cgbuf eenv sp expr sequel
-        assert (cenv.exprRecursionDepth = 1)
-    with
-    | :? System.InsufficientExecutionStackException ->
-        error(InternalError(sprintf "Expression is too large and/or complex to emit. Method name: '%s'. Recursive depth: %i." cgbuf.MethodName cenv.exprRecursionDepth, expr.Range))
+    GenExprAux cenv cgbuf eenv sp expr sequel
 
 /// Process the debug point and check for alternative ways to generate this expression.
 /// Returns 'true' if the expression was processed by alternative means.
@@ -5364,7 +5341,7 @@ and GetIlxClosureFreeVars cenv m (thisVars: ValRef list) boxity eenvouter takenN
         NestedTypeRefForCompLoc eenvouter.cloc cloName
 
     // Collect the free variables of the closure
-    let cloFreeVarResults = freeInExpr CollectTyparsAndLocals expr
+    let cloFreeVarResults = freeInExpr (CollectTyparsAndLocalsWithStackGuard()) expr
 
     // Partition the free variables when some can be accessed from places besides the immediate environment
     // Also filter out the current value being bound, if any, as it is available from the "this"
@@ -6851,20 +6828,10 @@ and GenMethodForBinding
                 | [h] -> Some h
                 | _ -> None
 
-            let ilCodeLazy = lazy CodeGenMethodForExpr cenv mgbuf (SPAlways, tailCallInfo, mspec.Name, eenvForMeth, 0, selfValOpt, bodyExpr, sequel)
+            let ilCodeLazy = CodeGenMethodForExpr cenv mgbuf (SPAlways, tailCallInfo, mspec.Name, eenvForMeth, 0, selfValOpt, bodyExpr, sequel)
 
             // This is the main code generation for most methods
-            false, MethodBody.IL(ilCodeLazy), false
-
-    match ilMethodBody with
-    | MethodBody.IL(ilCodeLazy) ->
-        if cenv.exprRecursionDepth > 0 then
-            cenv.delayedGenMethods.Enqueue(fun _ -> ilCodeLazy.Force() |> ignore)
-        else
-            // Eagerly codegen if we are not in an expression depth.
-            ilCodeLazy.Force() |> ignore
-    | _ ->
-        ()
+            false, MethodBody.IL(notlazy ilCodeLazy), false
 
     // Do not generate DllImport attributes into the code - they are implicit from the P/Invoke
     let attrs =
@@ -8924,8 +8891,7 @@ type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: Constrai
               intraAssemblyInfo = intraAssemblyInfo
               opts = codeGenOpts
               optimizeDuringCodeGen = (fun _flag expr -> expr)
-              exprRecursionDepth = 0
-              delayedGenMethods = Queue () }
+              stackGuard = StackGuard(IlxGenStackGuardDepth) }
         GenerateCode (cenv, anonTypeTable, ilxGenEnv, typedAssembly, assemAttribs, moduleAttribs)
 
     /// Invert the compilation of the given value and clear the storage of the value

src/fsharp/InnerLambdasToTopLevelFuncs.fs

@@ -22,6 +22,8 @@ open FSharp.Compiler.TcGlobals
 
 let verboseTLR = false
 
+let InnerLambdasToTopLevelFunctionsStackGuardDepth = StackGuard.GetDepthOption "InnerLambdasToTopLevelFunctions"
+
 //-------------------------------------------------------------------------
 // library helpers
 //-------------------------------------------------------------------------
@@ -482,7 +484,9 @@ module Pass2_DetermineReqdItems =
           if verboseTLR then dprintf "shortCall: not-rec: %s\n" gv.LogicalName
           state
 
-    let FreeInBindings bs = List.fold (foldOn (freeInBindingRhs CollectTyparsAndLocals) unionFreeVars) emptyFreeVars bs
+    let FreeInBindings bs =
+        let opts = CollectTyparsAndLocalsWithStackGuard()
+        List.fold (foldOn (freeInBindingRhs opts) unionFreeVars) emptyFreeVars bs
 
     /// Intercepts selected exprs.
     ///   "letrec f1, f2, ... = fBody1, fBody2, ... in rest" -
@@ -877,6 +881,7 @@ module Pass4_RewriteAssembly =
     type RewriteContext =
        { ccu: CcuThunk
          g: TcGlobals
+         stackGuard: StackGuard
          tlrS: Zset<Val>
          topValS: Zset<Val>
          arityM: Zmap<Val, int>
@@ -1098,6 +1103,7 @@ module Pass4_RewriteAssembly =
     /// At free vals, fixup 0-call if it is an arity-met constant.
     /// Other cases rewrite structurally.
     let rec TransExpr (penv: RewriteContext) (z: RewriteState) expr: Expr * RewriteState =
+        penv.stackGuard.Guard <| fun () ->
 
         match expr with
         // Use TransLinearExpr with a rebuild-continuation for some forms to avoid stack overflows on large terms 
@@ -1128,7 +1134,7 @@ module Pass4_RewriteAssembly =
 
         // reclink - suppress
         | Expr.Link r ->
-            TransExpr penv z (!r)
+            TransExpr penv z r.Value
 
         // ilobj - has implicit lambda exprs and recursive/base references
         | Expr.Obj (_, ty, basev, basecall, overrides, iimpls, m) ->
@@ -1177,7 +1183,7 @@ module Pass4_RewriteAssembly =
                 (typeDefs,argTypes,argExprs,data), z
 
             let data, z =
-                match !dataCell with 
+                match dataCell.Value with 
                 | Some (data1, data2) ->
                    let data1, z = doData data1 z
                    let data2, z = doData data2 z
@@ -1374,7 +1380,16 @@ let MakeTopLevelRepresentationDecisions ccu g expr =
       if verboseTLR then dprintf "TransExpr(rw)------\n"
       let expr, _ =
           let penv: Pass4_RewriteAssembly.RewriteContext =
-              {ccu=ccu; g=g; tlrS=tlrS; topValS=topValS; arityM=arityM; fclassM=fclassM; recShortCallS=recShortCallS; envPackM=envPackM; fHatM=fHatM}
+              { ccu = ccu
+                g = g
+                tlrS = tlrS
+                topValS = topValS
+                arityM = arityM
+                fclassM = fclassM
+                recShortCallS = recShortCallS
+                envPackM = envPackM
+                fHatM = fHatM
+                stackGuard = StackGuard(InnerLambdasToTopLevelFunctionsStackGuardDepth) }
           let z = Pass4_RewriteAssembly.rewriteState0
           Pass4_RewriteAssembly.TransImplFile penv z expr
 

src/fsharp/LowerCallsAndSeqs.fs

@@ -18,6 +18,8 @@ open FSharp.Compiler.TypedTree
 open FSharp.Compiler.TypedTreeBasics
 open FSharp.Compiler.TypedTreeOps
 
+let LowerCallsAndSeqsRewriteStackGuardDepth = StackGuard.GetDepthOption "LowerCallsAndSeqsRewrite"
+
 //----------------------------------------------------------------------------
 // Eta-expansion of calls to top-level-methods
 
@@ -53,10 +55,13 @@ let InterceptExpr g cont expr =
 /// any known arguments.  The results are later optimized by the peephole
 /// optimizer in opt.fs
 let LowerImplFile g assembly =
-    RewriteImplFile { PreIntercept = Some(InterceptExpr g)
-                      PreInterceptBinding=None
-                      PostTransform= (fun _ -> None)
-                      IsUnderQuotations=false } assembly
+    let rwenv =
+        { PreIntercept = Some(InterceptExpr g)
+          PreInterceptBinding=None
+          PostTransform= (fun _ -> None)
+          RewriteQuotations=false
+          StackGuard = StackGuard(LowerCallsAndSeqsRewriteStackGuardDepth) }
+    assembly |> RewriteImplFile rwenv
 
 //----------------------------------------------------------------------------
 // General helpers

src/fsharp/LowerStateMachines.fs

@@ -6,6 +6,7 @@ open Internal.Utilities.Collections
 open Internal.Utilities.Library
 open Internal.Utilities.Library.Extras
 open FSharp.Compiler.AbstractIL.IL
+open FSharp.Compiler.ErrorLogger
 open FSharp.Compiler.TcGlobals
 open FSharp.Compiler.Syntax
 open FSharp.Compiler.Syntax.PrettyNaming
@@ -13,6 +14,8 @@ open FSharp.Compiler.TypedTree
 open FSharp.Compiler.TypedTreeBasics
 open FSharp.Compiler.TypedTreeOps
 
+let LowerStateMachineStackGuardDepth = GetEnvInteger "FSHARP_LowerStateMachine" 50
+
 let mkLabelled m l e = mkCompGenSequential m (Expr.Op (TOp.Label l, [], [], m)) e
 
 type StateMachineConversionFirstPhaseResult =
@@ -354,7 +357,8 @@ type LowerStateMachine(g: TcGlobals) =
         { PreIntercept = Some (fun cont e -> match TryReduceExpr env e [] id with Some e2 -> Some (cont e2) | None -> None)
           PostTransform = (fun _ -> None)
           PreInterceptBinding = None
-          IsUnderQuotations=true } 
+          RewriteQuotations=true 
+          StackGuard = StackGuard(LowerStateMachineStackGuardDepth) }
 
     let ConvertStateMachineLeafExpression (env: env) expr = 
         if sm_verbose then printfn "ConvertStateMachineLeafExpression for %A..." expr

src/fsharp/Optimizer.fs

@@ -34,6 +34,8 @@ open FSharp.Compiler.TypeRelations
 open System.Collections.Generic
 open System.Collections.ObjectModel
 
+let OptimizerStackGuardDepth = GetEnvInteger "FSHARP_Optimizer" 50
+
 #if DEBUG
 let verboseOptimizationInfo = 
     try not (System.String.IsNullOrEmpty (System.Environment.GetEnvironmentVariable "FSHARP_verboseOptimizationInfo")) with _ -> false
@@ -428,6 +430,8 @@ type cenv =
       /// cache methods with SecurityAttribute applied to them, to prevent unnecessary calls to ExistsInEntireHierarchyOfType
       casApplied: Dictionary<Stamp, bool>
 
+      stackGuard: StackGuard
+
     }
 
     override x.ToString() = "<cenv>"
@@ -1198,7 +1202,7 @@ let AbstractExprInfoByVars (boundVars: Val list, boundTyVars) ivalue =
         
           // Check for escape in lambda 
           | CurriedLambdaValue (_, _, _, expr, _) | ConstExprValue(_, expr) when 
-            (let fvs = freeInExpr (if isNil boundTyVars then CollectLocals else CollectTyparsAndLocals) expr
+            (let fvs = freeInExpr (if isNil boundTyVars then (CollectLocalsWithStackGuard()) else CollectTyparsAndLocals) expr
              (not (isNil boundVars) && List.exists (Zset.memberOf fvs.FreeLocals) boundVars) ||
              (not (isNil boundTyVars) && List.exists (Zset.memberOf fvs.FreeTyvars.FreeTypars) boundTyVars) ||
              fvs.UsesMethodLocalConstructs) ->
@@ -1459,7 +1463,7 @@ let TryEliminateBinding cenv _env (TBind(vspec1, e1, spBind)) e2 _m =
         let IsUniqueUse vspec2 args = 
               valEq vspec1 vspec2  
            // REVIEW: this looks slow. Look only for one variable instead 
-           && (let fvs = accFreeInExprs CollectLocals args emptyFreeVars
+           && (let fvs = accFreeInExprs (CollectLocalsWithStackGuard()) args emptyFreeVars
                not (Zset.contains vspec1 fvs.FreeLocals))
 
         // Immediate consumption of value as 2nd or subsequent argument to a construction or projection operation 
@@ -2009,6 +2013,7 @@ let IsILMethodRefSystemStringConcatArray (mref: ILMethodRef) =
     
 /// Optimize/analyze an expression
 let rec OptimizeExpr cenv (env: IncrementalOptimizationEnv) expr =
+    cenv.stackGuard.Guard <| fun () ->
 
     // Eliminate subsumption coercions for functions. This must be done post-typechecking because we need
     // complete inference types.
@@ -2540,7 +2545,7 @@ and OptimizeLinearExpr cenv env expr contf =
       OptimizeLinearExpr cenv env body (contf << (fun (bodyR, bodyInfo) ->  
         // PERF: This call to ValueIsUsedOrHasEffect/freeInExpr amounts to 9% of all optimization time.
         // Is it quadratic or quasi-quadratic?
-        if ValueIsUsedOrHasEffect cenv (fun () -> (freeInExpr CollectLocals bodyR).FreeLocals) (bindR, bindingInfo) then
+        if ValueIsUsedOrHasEffect cenv (fun () -> (freeInExpr (CollectLocalsWithStackGuard()) bodyR).FreeLocals) (bindR, bindingInfo) then
             // Eliminate let bindings on the way back up
             let exprR, adjust = TryEliminateLet cenv env bindR bodyR m 
             exprR, 
@@ -3492,7 +3497,7 @@ and ComputeSplitToMethodCondition flag threshold cenv env (e: Expr, einfo) =
      // We can only split an expression out as a method if certain conditions are met. 
      // It can't use any protected or base calls, rethrow(), byrefs etc.
     let m = e.Range
-    (let fvs = freeInExpr CollectLocals e
+    (let fvs = freeInExpr (CollectLocalsWithStackGuard()) e
      not fvs.UsesUnboundRethrow &&
      not fvs.UsesMethodLocalConstructs &&
      fvs.FreeLocals |> Zset.forall (fun v -> 
@@ -3761,7 +3766,7 @@ and OptimizeModuleExpr cenv env x =
         let def = 
             if not cenv.settings.LocalOptimizationsEnabled then def else 
 
-            let fvs = freeInModuleOrNamespace CollectLocals def 
+            let fvs = freeInModuleOrNamespace (CollectLocalsWithStackGuard()) def 
             let dead = 
                 bindInfosColl |> List.filter (fun (bind, binfo) -> 
 
@@ -3919,6 +3924,7 @@ let OptimizeImplFile (settings, ccu, tcGlobals, tcVal, importMap, optEnv, isIncr
           localInternalVals=Dictionary<Stamp, ValInfo>(10000)
           emitTailcalls=emitTailcalls
           casApplied=Dictionary<Stamp, bool>() 
+          stackGuard = StackGuard(OptimizerStackGuardDepth) 
         }
 
     let env, _, _, _ as results = OptimizeImplFileInternal cenv optEnv isIncrementalFragment hidden mimpls  

src/fsharp/PostInferenceChecks.fs

@@ -60,7 +60,7 @@ open FSharp.Compiler.TypeRelations
 //     b) a lambda expression - rejected.
 //     c) none of the above - rejected as when checking outmost expressions.
 
-
+let PostInferenceChecksStackGuardDepth = GetEnvInteger "FSHARP_PostInferenceChecks" 50
 
 //--------------------------------------------------------------------------
 // check environment
@@ -208,6 +208,8 @@ type cenv =
 
       mutable anonRecdTypes: StampMap<AnonRecdTypeInfo> 
 
+      stackGuard: StackGuard
+
       g: TcGlobals 
 
       amap: Import.ImportMap 
@@ -453,7 +455,7 @@ let CheckEscapes cenv allowProtected m syntacticArgs body = (* m is a range suit
            (v.IsBaseVal || isByrefLikeTy cenv.g m v.Type) &&
            not (ListSet.contains valEq v syntacticArgs)
 
-        let frees = freeInExpr CollectLocals body
+        let frees = freeInExpr (CollectLocalsWithStackGuard()) body
         let fvs   = frees.FreeLocals 
 
         if not allowProtected && frees.UsesMethodLocalConstructs  then
@@ -1091,6 +1093,10 @@ and TryCheckResumableCodeConstructs cenv env expr : bool =
 
 /// Check an expression, given information about the position of the expression
 and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limit =    
+    
+    // Guard the stack for deeply nested expressions
+    cenv.stackGuard.Guard <| fun () ->
+    
     let g = cenv.g
 
     let origExpr = stripExpr origExpr
@@ -2579,22 +2585,23 @@ and CheckModuleSpec cenv env x =
 
 let CheckTopImpl (g, amap, reportErrors, infoReader, internalsVisibleToPaths, viewCcu, tcValF, denv, mexpr, extraAttribs, isLastCompiland: bool*bool, isInternalTestSpanStackReferring) =
     let cenv = 
-        { g =g  
-          reportErrors=reportErrors 
+        { g = g  
+          reportErrors = reportErrors 
           boundVals = Dictionary<_, _>(100, HashIdentity.Structural) 
           limitVals = Dictionary<_, _>(100, HashIdentity.Structural) 
-          potentialUnboundUsesOfVals=Map.empty 
+          stackGuard = StackGuard(PostInferenceChecksStackGuardDepth)
+          potentialUnboundUsesOfVals = Map.empty 
           anonRecdTypes = StampMap.Empty
-          usesQuotations=false 
-          infoReader=infoReader 
-          internalsVisibleToPaths=internalsVisibleToPaths
-          amap=amap 
-          denv=denv 
-          viewCcu= viewCcu
-          isLastCompiland=isLastCompiland
+          usesQuotations = false 
+          infoReader = infoReader 
+          internalsVisibleToPaths = internalsVisibleToPaths
+          amap = amap 
+          denv = denv 
+          viewCcu = viewCcu
+          isLastCompiland = isLastCompiland
           isInternalTestSpanStackReferring = isInternalTestSpanStackReferring
           tcVal = tcValF
-          entryPointGiven=false}
+          entryPointGiven = false}
     
     // Certain type equality checks go faster if these TyconRefs are pre-resolved.
     // This is because pre-resolving allows tycon equality to be determined by pointer equality on the entities.

src/fsharp/TypedTreeOps.fsi

@@ -8,6 +8,7 @@ open System.Collections.Immutable
 open Internal.Utilities.Collections
 open Internal.Utilities.Rational
 open FSharp.Compiler.AbstractIL.IL 
+open FSharp.Compiler.ErrorLogger
 open FSharp.Compiler.CompilerGlobalState
 open FSharp.Compiler.Syntax
 open FSharp.Compiler.Text
@@ -771,6 +772,10 @@ val CollectTyparsAndLocals: FreeVarOptions
 
 val CollectLocals: FreeVarOptions
 
+val CollectLocalsWithStackGuard: unit -> FreeVarOptions
+
+val CollectTyparsAndLocalsWithStackGuard: unit -> FreeVarOptions
+
 val CollectTypars: FreeVarOptions
 
 val CollectAllNoCaching: FreeVarOptions
@@ -2328,7 +2333,8 @@ type ExprRewritingEnv =
     { PreIntercept: ((Expr -> Expr) -> Expr -> Expr option) option
       PostTransform: Expr -> Expr option
       PreInterceptBinding: ((Expr -> Expr) -> Binding -> Binding option) option
-      IsUnderQuotations: bool }    
+      RewriteQuotations: bool
+      StackGuard: StackGuard }
 
 val RewriteDecisionTree: ExprRewritingEnv -> DecisionTree -> DecisionTree
 

src/fsharp/TypedTreePickle.fs

@@ -1527,7 +1527,7 @@ let p_trait_sln sln st =
 
 
 let p_trait (TTrait(a, b, c, d, e, f)) st  =
-    p_tup6 p_tys p_string p_MemberFlags p_tys (p_option p_ty) (p_option p_trait_sln) (a, b, c, d, e, !f) st
+    p_tup6 p_tys p_string p_MemberFlags p_tys (p_option p_ty) (p_option p_trait_sln) (a, b, c, d, e, f.Value) st
 
 let u_anonInfo_data st =
     let ccu, info, nms = u_tup3 u_ccuref u_bool (u_array u_ident) st
@@ -2561,7 +2561,7 @@ and u_op st =
 
 and p_expr expr st =
     match expr with
-    | Expr.Link e -> p_expr !e st
+    | Expr.Link e -> p_expr e.Value st
     | Expr.Const (x, m, ty)              -> p_byte 0 st; p_tup3 p_const p_dummy_range p_ty (x, m, ty) st
     | Expr.Val (a, b, m)                 -> p_byte 1 st; p_tup3 (p_vref "val") p_vrefFlags p_dummy_range (a, b, m) st
     | Expr.Op (a, b, c, d)                 -> p_byte 2 st; p_tup4 p_op  p_tys p_Exprs p_dummy_range (a, b, c, d) st

src/fsharp/absil/illib.fs

@@ -70,7 +70,7 @@ module internal PervasiveAutoOpens =
             x.EndsWith(value, StringComparison.Ordinal)
 
     /// Get an initialization hole 
-    let getHole r = match !r with None -> failwith "getHole" | Some x -> x
+    let getHole (r: _ ref) = match r.Value with None -> failwith "getHole" | Some x -> x
 
     let reportTime =
         let mutable tFirst =None
@@ -1146,19 +1146,18 @@ type LayeredMultiMap<'Key, 'Value when 'Key : equality and 'Key : comparison>(co
 
     member x.Add (k, v) = LayeredMultiMap(contents.Add(k, v :: x.[k]))
 
-    member x.Item with get k = match contents.TryGetValue k with true, l -> l | _ -> []
+    member _.Item with get k = match contents.TryGetValue k with true, l -> l | _ -> []
 
     member x.AddAndMarkAsCollapsible (kvs: _[]) = 
         let x = (x, kvs) ||> Array.fold (fun x (KeyValue(k, v)) -> x.Add(k, v))
         x.MarkAsCollapsible()
 
-    member x.MarkAsCollapsible() = LayeredMultiMap(contents.MarkAsCollapsible())
+    member _.MarkAsCollapsible() = LayeredMultiMap(contents.MarkAsCollapsible())
 
-    member x.TryFind k = contents.TryFind k
+    member _.TryFind k = contents.TryFind k
 
-    member x.TryGetValue k = contents.TryGetValue k
+    member _.TryGetValue k = contents.TryGetValue k
 
-    member x.Values = contents.Values |> List.concat
+    member _.Values = contents.Values |> List.concat
 
     static member Empty : LayeredMultiMap<'Key, 'Value> = LayeredMultiMap LayeredMap.Empty
-

src/fsharp/absil/ilprint.fs

@@ -20,9 +20,10 @@ let pretty () = true
 // --------------------------------------------------------------------
 
 let tyvar_generator =
-  let i = ref 0
+  let mutable i = 0
   fun n ->
-    incr i; n + string !i
+    i <- i + 1
+    n + string i
 
 // Carry an environment because the way we print method variables
 // depends on the gparams of the current scope.

src/fsharp/absil/ilwritepdb.fs

@@ -820,8 +820,11 @@ let writePdbInfo showTimes f fpdb info cvChunk =
                     if sps.Length < 5000 then
                         pdbDefineSequencePoints pdbw (getDocument spset.[0].Document) sps)
 
+              // Avoid stack overflow when writing linearly nested scopes
+              let stackGuard = StackGuard(100)
               // Write the scopes
               let rec writePdbScope parent sco =
+                  stackGuard.Guard <| fun () ->
                   if parent = None || sco.Locals.Length <> 0 || sco.Children.Length <> 0 then
                       // Only nest scopes if the child scope is a different size from
                       let nested =
@@ -1009,7 +1012,8 @@ let rec allNamesOfScope acc (scope: PdbMethodScope) =
 and allNamesOfScopes acc (scopes: PdbMethodScope[]) =
     (acc, scopes) ||> Array.fold allNamesOfScope
 
-let rec pushShadowedLocals (localsToPush: PdbLocalVar[]) (scope: PdbMethodScope) =
+let rec pushShadowedLocals (stackGuard: StackGuard) (localsToPush: PdbLocalVar[]) (scope: PdbMethodScope) =
+    stackGuard.Guard <| fun () ->
     // Check if child scopes are properly nested
     if scope.Children |> Array.forall (fun child ->
             child.StartOffset >= scope.StartOffset && child.EndOffset <= scope.EndOffset) then
@@ -1024,7 +1028,7 @@ let rec pushShadowedLocals (localsToPush: PdbLocalVar[]) (scope: PdbMethodScope)
         let renamed = [| for l in rename -> { l with Name = l.Name + " (shadowed)" } |]
 
         let localsToPush2 = [| yield! renamed; yield! unprocessed; yield! scope.Locals |]
-        let newChildren, splits = children |> Array.map (pushShadowedLocals localsToPush2) |> Array.unzip
+        let newChildren, splits = children |> Array.map (pushShadowedLocals stackGuard localsToPush2) |> Array.unzip
         
         // Check if a rename in any of the children forces a split
         if splits |> Array.exists id then
@@ -1058,5 +1062,7 @@ let rec pushShadowedLocals (localsToPush: PdbLocalVar[]) (scope: PdbMethodScope)
 //  2. Adjust each child scope to also contain the locals from 'scope', 
 //     adding the text " (shadowed)" to the names of those with name conflicts.
 let unshadowScopes rootScope =
-   let result, _ = pushShadowedLocals [| |] rootScope
-   result
+    // Avoid stack overflow when writing linearly nested scopes
+    let stackGuard = StackGuard(100)
+    let result, _ = pushShadowedLocals stackGuard [| |] rootScope
+    result

src/fsharp/autobox.fs

@@ -15,6 +15,8 @@ open FSharp.Compiler.TypeRelations
 //----------------------------------------------------------------------------
 // Decide the set of mutable locals to promote to heap-allocated reference cells
 
+let AutoboxRewriteStackGuardDepth = StackGuard.GetDepthOption "AutoboxRewrite"
+
 type cenv = 
     { g: TcGlobals
       amap: Import.ImportMap }
@@ -30,7 +32,7 @@ let DecideEscapes syntacticArgs body =
         v.ValReprInfo.IsNone &&
         not (Optimizer.IsKnownOnlyMutableBeforeUse (mkLocalValRef v))
 
-    let frees = freeInExpr CollectLocals body
+    let frees = freeInExpr (CollectLocalsWithStackGuard()) body
     frees.FreeLocals |> Zset.filter isMutableEscape 
 
 /// Find all the mutable locals that escape a lambda expression, ignoring the arguments to the lambda
@@ -190,6 +192,7 @@ let TransformImplFile g amap implFile =
               { PreIntercept = Some(TransformExpr g nvs)
                 PreInterceptBinding = Some(TransformBinding g nvs)
                 PostTransform = (fun _ -> None)
-                IsUnderQuotations = false } 
+                RewriteQuotations = false
+                StackGuard = StackGuard(AutoboxRewriteStackGuardDepth) } 
 
 

src/fsharp/fscmain.fs

@@ -4,7 +4,9 @@ module internal FSharp.Compiler.CommandLineMain
 
 open System
 open System.Reflection
+open System.Runtime
 open System.Runtime.CompilerServices
+open System.Threading
 
 open Internal.Utilities.Library 
 open Internal.Utilities.Library.Extras
@@ -30,7 +32,8 @@ let main(argv) =
             "fsc.exe"
 
     // Set the garbage collector to batch mode, which improves overall performance.
-    System.Runtime.GCSettings.LatencyMode <- System.Runtime.GCLatencyMode.Batch
+    GCSettings.LatencyMode <- GCLatencyMode.Batch
+    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

src/fsharp/lib.fs

@@ -544,18 +544,6 @@ module UnmanagedProcessExecutionOptions =
                             "HeapSetInformation() returned FALSE; LastError = 0x" +
                             GetLastError().ToString("X").PadLeft(8, '0') + "."))
 
-[<RequireQualifiedAccess>]
-module StackGuard =
-
-    open System.Runtime.CompilerServices
-
-    [<Literal>]
-    let private MaxUncheckedRecursionDepth = 20
-
-    let EnsureSufficientExecutionStack recursionDepth =
-        if recursionDepth > MaxUncheckedRecursionDepth then
-            RuntimeHelpers.EnsureSufficientExecutionStack ()
-
 [<RequireQualifiedAccess>]
 type MaybeLazy<'T> =
     | Strict of 'T

src/fsharp/lib.fsi

@@ -277,9 +277,6 @@ module AsyncUtil =
 module UnmanagedProcessExecutionOptions =
     val EnableHeapTerminationOnCorruption: unit -> unit
 
-module StackGuard =
-    val EnsureSufficientExecutionStack: recursionDepth:int -> unit
-
 [<RequireQualifiedAccess>]
 type MaybeLazy<'T> =
     | Strict of 'T

src/fsharp/tainted.fs

@@ -144,7 +144,9 @@ type internal Tainted<'T> (context: TaintedContext, value: 'T) =
         | Some x -> Some (Tainted(context,x))
 
     member this.PUntaint(f,range:range) = this.Protect f range
+
     member this.PUntaintNoFailure f = this.PUntaint(f, range0)
+
     /// Access the target object directly. Use with extreme caution.
     member this.AccessObjectDirectly = value
 

tests/FSharp.Test.Utilities/TestFramework.fs

@@ -216,6 +216,7 @@ type TestConfig =
       FSI : string
 #if !NETCOREAPP
       FSIANYCPU : string
+      FSCANYCPU : string
 #endif
       FSI_FOR_SCRIPTS : string
       FSharpBuild : string
@@ -335,8 +336,9 @@ let config configurationName envVars =
     let FSI_FOR_SCRIPTS = requireArtifact FSI_PATH
     let FSI = requireArtifact FSI_PATH
 #if !NETCOREAPP
-    let FSIANYCPU = requireArtifact ("fsiAnyCpu" ++ configurationName ++ "net472" ++ "fsiAnyCpu.exe")
     let FSC = requireArtifact ("fsc" ++ configurationName ++ fscArchitecture ++ "fsc.exe")
+    let FSIANYCPU = requireArtifact ("fsiAnyCpu" ++ configurationName ++ "net472" ++ "fsiAnyCpu.exe")
+    let FSCANYCPU = requireArtifact ("fscAnyCpu" ++ configurationName ++ fscArchitecture ++ "fscAnyCpu.exe")
 #else
     let FSC = requireArtifact ("fsc" ++ configurationName ++ fscArchitecture ++ "fsc.dll")
 #endif
@@ -360,6 +362,7 @@ let config configurationName envVars =
       FSC = FSC
       FSI = FSI
 #if !NETCOREAPP
+      FSCANYCPU = FSCANYCPU
       FSIANYCPU = FSIANYCPU
 #endif
       FSI_FOR_SCRIPTS = FSI_FOR_SCRIPTS
@@ -392,6 +395,7 @@ let logConfig (cfg: TestConfig) =
     log "DOTNET_ROOT              = %s" cfg.DotNetRoot
 #else
     log "FSIANYCPU                = %s" cfg.FSIANYCPU
+    log "FSCANYCPU                = %s" cfg.FSCANYCPU
 #endif
     log "FSI_FOR_SCRIPTS          = %s" cfg.FSI_FOR_SCRIPTS
     log "fsi_flags                = %s" cfg.fsi_flags

tests/fsharp/TypeProviderTests.fs

@@ -26,11 +26,11 @@ open FSharp.Compiler.IO
 
 #if NETCOREAPP
 // Use these lines if you want to test CoreCLR
-let FSC_BASIC = FSC_CORECLR
-let FSI_BASIC = FSI_CORECLR
+let FSC_OPTIMIZED = FSC_NETCORE (true, false)
+let FSI = FSI_NETCORE
 #else
-let FSC_BASIC = FSC_OPT_PLUS_DEBUG
-let FSI_BASIC = FSI_FILE
+let FSC_OPTIMIZED = FSC_NETFX (true, false)
+let FSI = FSI_NETFX
 #endif
 
 let inline getTestsDirectory dir = getTestsDirectory __SOURCE_DIRECTORY__ dir
@@ -147,11 +147,11 @@ let helloWorld p =
     peverify cfg (bincompat2 ++ "testlib_client.exe")
 
 [<Test>]
-let ``helloWorld fsc`` () = helloWorld FSC_BASIC
+let ``helloWorld fsc`` () = helloWorld FSC_OPTIMIZED
 
 #if !NETCOREAPP
 [<Test>]
-let ``helloWorld fsi`` () = helloWorld FSI_STDIN
+let ``helloWorld fsi`` () = helloWorld FSI_NETFX_STDIN
 #endif
 
 [<Test>]

tests/fsharp/core/innerpoly/test.fsx

@@ -448,7 +448,7 @@ module Bug11620A =
         (fun () -> getService)
 
 // The generated signature for this bug repro has mistakes, we are not enabling it yet
-#if !GENERATED_SIGNATURE
+#if !FSC_NETFX_TEST_GENERATED_SIGNATURE
 module Bug11620B =
 
     type Data = interface end

tests/fsharp/readme.md

@@ -11,7 +11,7 @@ The framework and utilities can be found in test-framework.fs, single-test.fs, c
 test cases look similar to:
 ````
     [<Test>]
-    let ``array-FSI_BASIC`` () = singleTestBuildAndRun "core/array" FSI_BASIC
+    let ``array-FSI`` () = singleTestBuildAndRun "core/array" FSI
 ````
 This test case builds and runs the test case in the folder core/array
 

tests/fsharp/single-test.fs

@@ -8,18 +8,15 @@ open HandleExpects
 open FSharp.Compiler.IO
 
 type Permutation =
-    | FSC_CORECLR
-    | FSC_CORECLR_OPT_MINUS
-    | FSC_CORECLR_BUILDONLY
-    | FSI_CORECLR
-#if !NETCOREAPP
-    | FSI_FILE
-    | FSI_STDIN
-    | GENERATED_SIGNATURE
-    | FSC_BUILDONLY
-    | FSC_OPT_MINUS_DEBUG
-    | FSC_OPT_PLUS_DEBUG
-    | AS_DLL
+#if NETCOREAPP
+    | FSC_NETCORE of optimized: bool * buildOnly: bool
+    | FSI_NETCORE
+#else
+    | FSC_NETFX of optimized: bool * buildOnly: bool
+    | FSI_NETFX
+    | FSI_NETFX_STDIN
+    | FSC_NETFX_TEST_GENERATED_SIGNATURE
+    | FSC_NETFX_TEST_ROUNDTRIP_AS_DLL
 #endif
 
 // Because we build programs ad dlls the compiler will copy an fsharp.core.dll into the build directory
@@ -306,18 +303,14 @@ let singleTestBuildAndRunCore cfg copyFiles p languageVersion =
                 printfn "Filename: %s" projectFileName
 
     match p with
-    | FSC_CORECLR -> executeSingleTestBuildAndRun OutputType.Exe "coreclr" "net5.0" true false
-    | FSC_CORECLR_OPT_MINUS -> executeSingleTestBuildAndRun OutputType.Exe "coreclr" "net5.0" false false
-    | FSC_CORECLR_BUILDONLY -> executeSingleTestBuildAndRun OutputType.Exe "coreclr" "net5.0" true true
-    | FSI_CORECLR -> executeSingleTestBuildAndRun OutputType.Script "coreclr" "net5.0" true false
-
-#if !NETCOREAPP
-    | FSC_BUILDONLY -> executeSingleTestBuildAndRun OutputType.Exe "net40" "net472" false true
-    | FSC_OPT_PLUS_DEBUG -> executeSingleTestBuildAndRun OutputType.Exe "net40" "net472" true false
-    | FSC_OPT_MINUS_DEBUG -> executeSingleTestBuildAndRun OutputType.Exe "net40" "net472" false false
-    | FSI_FILE -> executeSingleTestBuildAndRun OutputType.Script "net40" "net472" true false
-
-    | FSI_STDIN ->
+#if NETCOREAPP
+    | FSC_NETCORE (optimized, buildOnly) -> executeSingleTestBuildAndRun OutputType.Exe "coreclr" "net5.0" optimized buildOnly
+    | FSI_NETCORE -> executeSingleTestBuildAndRun OutputType.Script "coreclr" "net5.0" true false
+#else
+    | FSC_NETFX (optimized, buildOnly) -> executeSingleTestBuildAndRun OutputType.Exe "net40" "net472" optimized buildOnly
+    | FSI_NETFX -> executeSingleTestBuildAndRun OutputType.Script "net40" "net472" true false
+
+    | FSI_NETFX_STDIN ->
         use _cleanup = (cleanUpFSharpCore cfg)
         use testOkFile = new FileGuard (getfullpath cfg "test.ok")
         let sources = extraSources |> List.filter (fileExists cfg)
@@ -326,7 +319,7 @@ let singleTestBuildAndRunCore cfg copyFiles p languageVersion =
 
         testOkFile.CheckExists()
 
-    | GENERATED_SIGNATURE ->
+    | FSC_NETFX_TEST_GENERATED_SIGNATURE ->
         use _cleanup = (cleanUpFSharpCore cfg)
 
         let source1 =
@@ -337,7 +330,7 @@ let singleTestBuildAndRunCore cfg copyFiles p languageVersion =
         source1 |> Option.iter (fun from -> copy_y cfg from "tmptest.fs")
 
         log "Generated signature file..."
-        fsc cfg "%s --sig:tmptest.fsi --define:GENERATED_SIGNATURE" cfg.fsc_flags ["tmptest.fs"]
+        fsc cfg "%s --sig:tmptest.fsi --define:FSC_NETFX_TEST_GENERATED_SIGNATURE" cfg.fsc_flags ["tmptest.fs"]
 
         log "Compiling against generated signature file..."
         fsc cfg "%s -o:tmptest1.exe" cfg.fsc_flags ["tmptest.fsi";"tmptest.fs"]
@@ -345,7 +338,7 @@ let singleTestBuildAndRunCore cfg copyFiles p languageVersion =
         log "Verifying built .exe..."
         peverify cfg "tmptest1.exe"
 
-    | AS_DLL ->
+    | FSC_NETFX_TEST_ROUNDTRIP_AS_DLL ->
         // Compile as a DLL to exercise pickling of interface data, then recompile the original source file referencing this DLL
         // THe second compilation will not utilize the information from the first in any meaningful way, but the
         // compiler will unpickle the interface and optimization data, so we test unpickling as well.