Allow checking cancellation inside analysis

src/Compiler/Checking/PatternMatchCompilation.fs

@@ -1146,6 +1146,8 @@ let CompilePatternBasic
 
     // The main recursive loop of the pattern match compiler.
     let rec InvestigateFrontiers refuted frontiers =
+        Cancellable.CheckAndThrow()
+
         match frontiers with
         | [] -> failwith "CompilePattern: compile - empty clauses: at least the final clause should always succeed"
         | Frontier (i, active, valMap) :: rest ->

src/Compiler/Facilities/DiagnosticsLogger.fs

@@ -857,11 +857,13 @@ type StackGuard(maxDepth: int, name: string) =
             if depth % maxDepth = 0 then
                 let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger
                 let buildPhase = DiagnosticsThreadStatics.BuildPhase
+                let ct = Cancellable.Token
 
                 async {
                     do! Async.SwitchToNewThread()
                     Thread.CurrentThread.Name <- $"F# Extra Compilation Thread for {name} (depth {depth})"
                     use _scope = new CompilationGlobalsScope(diagnosticsLogger, buildPhase)
+                    use _token = Cancellable.UsingToken ct
                     return f ()
                 }
                 |> Async.RunImmediate

src/Compiler/Utilities/Cancellable.fs

@@ -1,7 +1,44 @@
+namespace FSharp.Compiler
+
+open System
+open System.Threading
+open Internal.Utilities.Library
+
+[<Sealed>]
+type Cancellable =
+    [<ThreadStatic; DefaultValue>]
+    static val mutable private tokens: CancellationToken list
+
+    static member private Tokens
+        with get () =
+            match box Cancellable.tokens with
+            | Null -> []
+            | _ -> Cancellable.tokens
+        and set v = Cancellable.tokens <- v
+
+    static member UsingToken(ct) =
+        Cancellable.Tokens <- ct :: Cancellable.Tokens
+
+        { new IDisposable with
+            member this.Dispose() =
+                Cancellable.Tokens <- Cancellable.Tokens |> List.tail }
+
+    static member Token =
+        match Cancellable.Tokens with
+        | [] -> CancellationToken.None
+        | token :: _ -> token
+
+    static member CheckAndThrow() =
+        match Cancellable.Tokens with
+        | [] -> ()
+        | token :: _ -> token.ThrowIfCancellationRequested()
+
+
 namespace Internal.Utilities.Library
 
 open System
 open System.Threading
+open FSharp.Compiler
 
 [<RequireQualifiedAccess; Struct>]
 type ValueOrCancelled<'TResult> =
@@ -17,7 +54,11 @@ module Cancellable =
         if ct.IsCancellationRequested then
             ValueOrCancelled.Cancelled(OperationCanceledException ct)
         else
-            oper ct
+            try
+                use _ = Cancellable.UsingToken(ct)
+                oper ct
+            with :? OperationCanceledException as e ->
+                ValueOrCancelled.Cancelled(OperationCanceledException e.CancellationToken)
 
     let fold f acc seq =
         Cancellable(fun ct ->

src/Compiler/Utilities/Cancellable.fsi

@@ -1,3 +1,15 @@
+namespace FSharp.Compiler
+
+open System
+open System.Threading
+
+[<Sealed>]
+type Cancellable =
+    static member internal UsingToken: CancellationToken -> IDisposable
+    static member Token: CancellationToken
+    static member CheckAndThrow: unit -> unit
+
+
 namespace Internal.Utilities.Library
 
 open System