Skip to content

Commit 258d1b5

Browse files
committed
simplify and speed up a bit
1 parent ab0d07d commit 258d1b5

File tree

4 files changed

+105
-157
lines changed

4 files changed

+105
-157
lines changed

src/Compiler/Checking/CheckDeclarations.fs

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1371,7 +1371,7 @@ module MutRecBindingChecking =
13711371
let baseTy, tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurrence.Use WarnOnIWSAM.Yes envInstance tpenv synBaseTy
13721372
let baseTy = baseTy |> convertToTypeWithMetadataIfPossible g
13731373
TcNewExpr cenv envInstance tpenv baseTy (Some synBaseTy.Range) true arg m
1374-
with RecoverableException e ->
1374+
with e ->
13751375
errorRecovery e m
13761376
mkUnit g m, tpenv
13771377
let envInstance = match baseValOpt with Some baseVal -> AddLocalVal g cenv.tcSink scopem baseVal envInstance | None -> envInstance
@@ -5020,7 +5020,7 @@ let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcE
50205020

50215021
return env
50225022

5023-
with RecoverableException exn ->
5023+
with exn ->
50245024
errorRecovery exn endm
50255025
return env
50265026
}
@@ -5496,7 +5496,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem
54965496
return
54975497
(defns, [], topAttrs), env, envAtEnd
54985498

5499-
with RecoverableException exn ->
5499+
with exn ->
55005500
errorRecovery exn synDecl.Range
55015501
return ([], [], []), env, env
55025502
}
@@ -5813,7 +5813,7 @@ let CheckOneImplFile
58135813
for check in cenv.css.GetPostInferenceChecksPreDefaults() do
58145814
try
58155815
check()
5816-
with RecoverableException exn ->
5816+
with exn ->
58175817
errorRecovery exn m
58185818

58195819
conditionallySuppressErrorReporting (checkForErrors()) (fun () ->

src/Compiler/Facilities/DiagnosticsLogger.fs

Lines changed: 12 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -882,22 +882,23 @@ type StackGuard(maxDepth: int, name: string) =
882882
[<CallerLineNumber; Optional; DefaultParameterValue(0)>] line: int
883883
) =
884884

885-
Activity.addEventWithTags
886-
"DiagnosticsLogger.StackGuard.Guard"
887-
(seq {
888-
Activity.Tags.stackGuardName, box name
889-
Activity.Tags.stackGuardCurrentDepth, depth
890-
Activity.Tags.stackGuardMaxDepth, maxDepth
891-
Activity.Tags.callerMemberName, memberName
892-
Activity.Tags.callerFilePath, path
893-
Activity.Tags.callerLineNumber, line
894-
})
895-
896885
depth <- depth + 1
897886

898887
try
899888
if depth % maxDepth = 0 then
900889

890+
use _ =
891+
Activity.start
892+
"DiagnosticsLogger.StackGuard.Guard"
893+
(seq {
894+
Activity.Tags.stackGuardName, name
895+
Activity.Tags.stackGuardCurrentDepth, string depth
896+
Activity.Tags.stackGuardMaxDepth, string maxDepth
897+
Activity.Tags.callerMemberName, memberName
898+
Activity.Tags.callerFilePath, path
899+
Activity.Tags.callerLineNumber, string line
900+
})
901+
901902
async {
902903
do! Async.SwitchToNewThread()
903904
Thread.CurrentThread.Name <- $"F# Extra Compilation Thread for {name} (depth {depth})"

src/Compiler/Utilities/Cancellable.fs

Lines changed: 78 additions & 114 deletions
Original file line numberDiff line numberDiff line change
@@ -65,24 +65,19 @@ open System.Runtime.ExceptionServices
6565
open System.Diagnostics
6666

6767
type ITrampolineInvocation =
68-
abstract member MoveNext: unit -> unit
68+
abstract member MoveNext: unit -> bool
6969
abstract IsCompleted: bool
70-
abstract ReplayExceptionIfStored: unit -> unit
7170

72-
[<Struct; NoComparison; NoEquality>]
73-
type CancellableStateMachineData<'T> =
74-
75-
[<DefaultValue(false)>]
76-
val mutable Result: 'T
71+
type internal CancellableStateMachine<'TOverall> = ResumableStateMachine<'TOverall>
72+
type internal ICancellableStateMachine<'TOverall> = IResumableStateMachine<'TOverall>
73+
type internal CancellableResumptionFunc<'TOverall> = ResumptionFunc<'TOverall>
74+
type internal CancellableResumptionDynamicInfo<'TOverall> = ResumptionDynamicInfo<'TOverall>
75+
type internal CancellableCode<'TOverall, 'T> = ResumableCode<'TOverall, 'T>
7776

78-
[<DefaultValue(false)>]
79-
val mutable NextInvocation: ITrampolineInvocation voption
80-
81-
and CancellableStateMachine<'TOverall> = ResumableStateMachine<CancellableStateMachineData<'TOverall>>
82-
and ICancellableStateMachine<'TOverall> = IResumableStateMachine<CancellableStateMachineData<'TOverall>>
83-
and CancellableResumptionFunc<'TOverall> = ResumptionFunc<CancellableStateMachineData<'TOverall>>
84-
and CancellableResumptionDynamicInfo<'TOverall> = ResumptionDynamicInfo<CancellableStateMachineData<'TOverall>>
85-
and CancellableCode<'TOverall, 'T> = ResumableCode<CancellableStateMachineData<'TOverall>, 'T>
77+
[<Struct; NoComparison; NoEquality>]
78+
type PendingInvocation =
79+
| Delayed of ITrampolineInvocation
80+
| Immediate of ITrampolineInvocation
8681

8782
[<Sealed>]
8883
type Trampoline(cancellationToken: CancellationToken) =
@@ -92,9 +87,19 @@ type Trampoline(cancellationToken: CancellationToken) =
9287
[<Literal>]
9388
static let bindDepthLimit = 100
9489

95-
static let current = new ThreadLocal<Trampoline>()
90+
static let current = new AsyncLocal<Trampoline voption>()
9691

97-
let delayed = System.Collections.Generic.Stack<ITrampolineInvocation>()
92+
let pending = System.Collections.Generic.Stack<_>()
93+
94+
let mutable lastError: ExceptionDispatchInfo voption = ValueNone
95+
let mutable storedError: ExceptionDispatchInfo voption = ValueNone
96+
97+
member _.ReplayException() =
98+
match storedError with
99+
| ValueSome edi ->
100+
storedError <- ValueNone
101+
edi.Throw()
102+
| _ -> ()
98103

99104
member this.IsCancelled = cancellationToken.IsCancellationRequested
100105

@@ -103,110 +108,74 @@ type Trampoline(cancellationToken: CancellationToken) =
103108

104109
member this.ShoudBounce = bindDepth % bindDepthLimit = 0
105110

106-
static member Install ct = current.Value <- Trampoline ct
111+
member this.SetDelayed(invocation) = pending.Push(Delayed invocation)
107112

108-
member val LastError: ExceptionDispatchInfo voption = ValueNone with get, set
113+
member this.RunImmediate(invocation: ITrampolineInvocation) =
114+
let captureException exn =
115+
match lastError with
116+
| ValueSome edi when edi.SourceException = exn -> ()
117+
| _ -> lastError <- ValueSome <| ExceptionDispatchInfo.Capture exn
109118

110-
member this.RunDelayed(continuation, invocation) =
111-
// The calling state machine is now suspended. We need to resume it next.
112-
delayed.Push continuation
113-
// Schedule the delayed invocation to run.
114-
delayed.Push invocation
119+
storedError <- lastError
115120

116-
member this.RunImmediate(invocation: ITrampolineInvocation) =
117121
bindDepth <- bindDepth + 1
118122

119-
try
120-
// This can throw, which is fine. We want the exception to propagate to the calling machine.
121-
invocation.MoveNext()
123+
pending.Push(Immediate invocation)
122124

125+
try
123126
while not invocation.IsCompleted do
124-
if delayed.Peek().IsCompleted then
125-
delayed.Pop() |> ignore
126-
else
127-
delayed.Peek().MoveNext()
128-
// In case this was a delayed invocation, which captures the exception, we need to replay it.
129-
invocation.ReplayExceptionIfStored()
127+
match pending.Peek() with
128+
| Immediate i ->
129+
if i.MoveNext() then
130+
pending.Pop() |> ignore
131+
| Delayed d ->
132+
try
133+
if d.MoveNext() then
134+
pending.Pop() |> ignore
135+
with exn ->
136+
pending.Pop() |> ignore
137+
captureException exn
138+
139+
this.ReplayException()
130140
finally
131141
bindDepth <- bindDepth - 1
132142

133-
static member Current = current.Value
143+
static member Current = current.Value.Value
144+
145+
static member Install ct =
146+
current.Value <- ValueSome <| Trampoline ct
134147

135148
type ITrampolineInvocation<'T> =
136149
inherit ITrampolineInvocation
137150
abstract Result: 'T
138151

139-
[<AutoOpen>]
140-
module ExceptionDispatchInfoHelpers =
141-
type ExceptionDispatchInfo with
142-
member edi.ThrowAny() =
143-
edi.Throw()
144-
Unchecked.defaultof<_>
145-
146-
static member RestoreOrCapture(exn: exn) =
147-
match Trampoline.Current.LastError with
148-
| ValueSome edi when edi.SourceException = exn -> edi
149-
| _ ->
150-
let edi = ExceptionDispatchInfo.Capture exn
151-
Trampoline.Current.LastError <- ValueSome edi
152-
edi
153-
154152
[<NoEquality; NoComparison>]
155153
type ICancellableInvokable<'T> =
156-
abstract Create: bool -> ITrampolineInvocation<'T>
154+
abstract Create: unit -> ITrampolineInvocation<'T>
157155

158156
[<NoEquality; NoComparison>]
159-
type CancellableInvocation<'T, 'Machine when 'Machine :> IAsyncStateMachine and 'Machine :> ICancellableStateMachine<'T>>
160-
(machine: 'Machine, delayed: bool) =
157+
type CancellableInvocation<'T, 'Machine
158+
when 'Machine: struct and 'Machine :> IAsyncStateMachine and 'Machine :> ICancellableStateMachine<'T>>(machine: 'Machine) =
161159
let mutable machine = machine
162-
let mutable storedException = ValueNone
163-
let mutable finished = false
164-
165-
new(machine) = CancellableInvocation(machine, false)
166160

167161
interface ITrampolineInvocation<'T> with
168-
member this.MoveNext() =
169-
let pushDelayed () =
170-
match machine.Data.NextInvocation with
171-
| ValueSome delayed -> Trampoline.Current.RunDelayed(this, delayed)
172-
| _ -> finished <- true
173-
174-
if delayed then
175-
// If the invocation is delayed, we need to store the exception.
176-
try
177-
machine.MoveNext()
178-
pushDelayed ()
179-
with exn ->
180-
finished <- true
181-
storedException <- ValueSome <| ExceptionDispatchInfo.RestoreOrCapture exn
182-
else
183-
machine.MoveNext()
184-
pushDelayed ()
185-
186-
member _.Result = machine.Data.Result
187-
member _.IsCompleted = finished
188-
189-
member _.ReplayExceptionIfStored() =
190-
storedException |> ValueOption.iter _.Throw()
162+
member _.MoveNext() =
163+
machine.MoveNext()
164+
machine.ResumptionPoint = -1
191165

192-
interface ICancellableInvokable<'T> with
193-
member _.Create(delayed) =
194-
CancellableInvocation<_, _>(machine, delayed)
166+
member _.Result = machine.Data
167+
member _.IsCompleted = machine.ResumptionPoint = -1
195168

196169
[<Struct; NoComparison>]
197-
type Cancellable<'T>(invokable: ICancellableInvokable<'T>) =
170+
type Cancellable<'T>(clone: unit -> ITrampolineInvocation<'T>) =
198171

199-
member _.GetInvocation(delayed) = invokable.Create(delayed)
172+
member _.GetInvocation() = clone ()
200173

201174
[<AutoOpen>]
202175
module CancellableCode =
203176

204177
let inline filterCancellation (catch: exn -> CancellableCode<_, _>) exn =
205-
CancellableCode(fun sm ->
206-
try
207-
(catch exn).Invoke(&sm)
208-
with :? OperationCanceledException when Trampoline.Current.IsCancelled ->
209-
true)
178+
CancellableCode(fun sm -> Trampoline.Current.IsCancelled || (catch exn).Invoke(&sm))
210179

211180
let inline throwIfCancellationRequested (code: CancellableCode<_, _>) =
212181
CancellableCode(fun sm ->
@@ -223,7 +192,7 @@ type CancellableBuilder() =
223192

224193
member inline _.Return(value: 'T) : CancellableCode<'T, 'T> =
225194
CancellableCode<'T, _>(fun sm ->
226-
sm.Data.Result <- value
195+
sm.Data <- value
227196
true)
228197

229198
member inline _.Combine
@@ -266,39 +235,35 @@ type CancellableBuilder() =
266235
: CancellableCode<'Data, 'T> =
267236
CancellableCode(fun sm ->
268237
if __useResumableCode then
269-
let mutable invocation = code.GetInvocation Trampoline.Current.ShoudBounce
238+
let mutable invocation = code.GetInvocation()
270239

271240
if Trampoline.Current.ShoudBounce then
272241
// Suspend this state machine and schedule both parts to run on the trampoline.
273242
match __resumableEntry () with
274243
// Suspending
275244
| Some contID ->
276245
sm.ResumptionPoint <- contID
277-
sm.Data.NextInvocation <- ValueSome invocation
246+
Trampoline.Current.SetDelayed invocation
278247
false
279248
// Resuming
280249
| None ->
281-
sm.Data.NextInvocation <- ValueNone
282-
// At this point we either have a result or an exception.
283-
invocation.ReplayExceptionIfStored()
250+
Trampoline.Current.ReplayException()
284251
(continuation invocation.Result).Invoke(&sm)
285252
else
286253
Trampoline.Current.RunImmediate invocation
287254
(continuation invocation.Result).Invoke(&sm)
288255

289256
else
290257
// Dynamic Bind.
291-
292-
let mutable invocation = code.GetInvocation Trampoline.Current.ShoudBounce
258+
let mutable invocation = code.GetInvocation()
293259

294260
if Trampoline.Current.ShoudBounce then
295261
let cont =
296262
CancellableResumptionFunc<'Data>(fun sm ->
297-
sm.Data.NextInvocation <- ValueNone
298-
invocation.ReplayExceptionIfStored()
263+
Trampoline.Current.ReplayException()
299264
(continuation invocation.Result).Invoke(&sm))
300265

301-
sm.Data.NextInvocation <- ValueSome invocation
266+
Trampoline.Current.SetDelayed invocation
302267
sm.ResumptionDynamicInfo.ResumptionFunc <- cont
303268
false
304269
else
@@ -320,7 +285,9 @@ type CancellableBuilder() =
320285

321286
(SetStateMachineMethodImpl<_>(fun _ _ -> ()))
322287

323-
(AfterCode<_, _>(fun sm -> Cancellable(CancellableInvocation(sm))))
288+
(AfterCode<_, _>(fun sm ->
289+
let copy = sm
290+
Cancellable(fun () -> CancellableInvocation(copy))))
324291
else
325292
// Dynamic Run.
326293

@@ -336,8 +303,7 @@ type CancellableBuilder() =
336303
}
337304

338305
let sm = CancellableStateMachine(ResumptionDynamicInfo = resumptionInfo)
339-
340-
Cancellable(CancellableInvocation(sm))
306+
Cancellable(fun () -> CancellableInvocation(sm))
341307

342308
namespace Internal.Utilities.Library
343309

@@ -354,22 +320,20 @@ module CancellableAutoOpens =
354320
module Cancellable =
355321
open Internal.Utilities.Library.CancellableImplementation
356322

357-
let run ct (code: Cancellable<_>) =
358-
use _ = FSharp.Compiler.Cancellable.UsingToken ct
359-
360-
let invocation = code.GetInvocation(false)
361-
Trampoline.Install ct
323+
let run (code: Cancellable<_>) =
324+
let invocation = code.GetInvocation()
325+
Trampoline.Install FSharp.Compiler.Cancellable.Token
362326
Trampoline.Current.RunImmediate invocation
363-
invocation
327+
invocation.Result
364328

365329
let runWithoutCancellation code =
366-
code |> run CancellationToken.None |> _.Result
330+
use _ = FSharp.Compiler.Cancellable.UsingToken CancellationToken.None
331+
run code
367332

368333
let toAsync code =
369334
async {
370-
let! ct = Async.CancellationToken
371-
372-
return run ct code |> _.Result
335+
use! _holder = FSharp.Compiler.Cancellable.UseToken()
336+
return run code
373337
}
374338

375339
let token () =

0 commit comments

Comments
 (0)