@@ -448,6 +448,46 @@ module Dictionary =
448448module Lazy =
449449let force ( x : Lazy < 'T >) = x.Force()
450450
451+ //----------------------------------------------------------------------------
452+ // Singe threaded execution and mutual exclusion
453+
454+ /// Represents a permission active at this point in execution
455+ type ExecutionToken = interface end
456+
457+ /// Represents a token that indicates execution on the compilation thread, i.e.
458+ /// - we have full access to the (partially mutable) TAST and TcImports data structures
459+ /// - compiler execution may result in type provider invocations when resolving types and members
460+ /// - we can access various caches in the SourceCodeServices
461+ ///
462+ /// Like other execution tokens this should be passed via argument passing and not captured/stored beyond
463+ /// the lifetime of stack-based calls. This is not checked, it is a discipline withinn the compiler code.
464+ type CompilationThreadToken () = interface ExecutionToken
465+
466+ /// Represnts a place where we are stating that execution on the compilation thread is required. The
467+ /// reason why will be documented in a comment in the code at the callsite.
468+ let RequireCompilationThread ( _ctok : CompilationThreadToken ) = ()
469+
470+ /// Represnts a place in the compiler codebase where we are passed a CompilationThreadToken unnecessarily.
471+ /// This reprents code that may potentially not need to be executed on the compilation thread.
472+ let DoesNotRequireCompilerThreadTokenAndCouldPossiblyBeMadeConcurrent ( _ctok : CompilationThreadToken ) = ()
473+
474+ /// Represnts a place in the compiler codebase where we assume we are executing on a compilation thread
475+ let AssumeCompilationThreadWithoutEvidence () = Unchecked.defaultof< CompilationThreadToken>
476+
477+ /// Represents a token that indicates execution on a any of several potential user threads calling the F# compiler services.
478+ type AnyCallerThreadToken () = interface ExecutionToken
479+ let AssumeAnyCallerThreadWithoutEvidence () = Unchecked.defaultof< AnyCallerThreadToken>
480+
481+ /// A base type for various types of tokens that must be passed when a lock is taken.
482+ /// Each different static lock should declare a new subtype of this type.
483+ type LockToken = inherit ExecutionToken
484+ let AssumeLockWithoutEvidence < 'LockTokenType when 'LockTokenType :> LockToken > () = Unchecked.defaultof< 'LockTokenType>
485+
486+ /// Encapsulates a lock associated with a particular token-type representing the acquisition of that lock.
487+ type Lock < 'LockTokenType when 'LockTokenType :> LockToken >() =
488+ let lockObj = obj()
489+ member __.AcquireLock f = lock lockObj( fun () -> ( AssumeLockWithoutEvidence< 'LockTokenType>()))
490+
451491//---------------------------------------------------
452492// Misc
453493
@@ -495,7 +535,7 @@ module ResultOrException =
495535/// Eventually.repeatedlyProgressUntilDoneOrTimeShareOverOrCanceled
496536type Eventually < 'T > =
497537| Doneof 'T
498- | NotYetDoneof ( unit -> Eventually < 'T >)
538+ | NotYetDoneof ( CompilationThreadToken -> Eventually < 'T >)
499539
500540[<CompilationRepresentation( CompilationRepresentationFlags.ModuleSuffix) >]
501541module Eventually =
@@ -504,42 +544,42 @@ module Eventually =
504544let rec box e =
505545match ewith
506546| Done x-> Done( Operators.box x)
507- | NotYetDone( work) -> NotYetDone( fun () -> ( work() ))
547+ | NotYetDone( work) -> NotYetDone( fun ctok -> box( work ctok ))
508548
509- let rec forceWhile check e =
549+ let rec forceWhile ctok check e=
510550match ewith
511551| Done x-> Some( x)
512552| NotYetDone( work) ->
513553if not ( check())
514554then None
515- else forceWhile check( work() )
555+ else forceWhilectok check( work ctok )
516556
517- let force e = Option.get( forceWhile( fun () -> true ) e)
557+ let force ctok e= Option.get( forceWhile ctok ( fun () -> true ) e)
518558
519559
520560/// Keep running the computation bit by bit until a time limit is reached.
521561/// The runner gets called each time the computation is restarted
522562let repeatedlyProgressUntilDoneOrTimeShareOverOrCanceled timeShareInMilliseconds ( ct : CancellationToken ) runner e =
523563let sw = new System.Diagnostics.Stopwatch()
524- let rec runTimeShare e =
525- runner( fun () ->
564+ let rec runTimeShare ctok e=
565+ runnerctok ( fun ctok ->
526566 sw.Reset()
527567 sw.Start();
528- let rec loop ( e ) =
529- match e with
530- | Done_ -> e
568+ let rec loop ctok ev2 =
569+ match ev2 with
570+ | Done_ -> ev2
531571| NotYetDone work->
532572if ct.IsCancellationRequested|| sw.ElapsedMilliseconds> timeShareInMillisecondsthen
533573 sw.Stop();
534- NotYetDone( fun () -> e )
574+ NotYetDone( fun ctok -> runTimeSharectok ev2 )
535575else
536- loop( work() )
537- loop( e ) )
538- runTimeSharee
576+ loop ctok ( work ctok )
577+ loop ctok e )
578+ NotYetDone ( fun ctok -> ctok e )
539579
540580/// Keep running the asynchronous computation bit by bit. The runner gets called each time the computation is restarted.
541581/// Can be cancelled in the normal way.
542- let forceAsync ( runner : ( unit -> Eventually < 'T >) -> Async < Eventually < 'T >>) ( e : Eventually < 'T >) : Async < 'T option > =
582+ let forceAsync ( runner : ( CompilationThreadToken -> Eventually < 'T >) -> Async < Eventually < 'T >>) ( e : Eventually < 'T >) : Async < 'T option > =
543583let rec loop ( e : Eventually < 'T >) =
544584async {
545585match ewith
@@ -553,7 +593,7 @@ module Eventually =
553593let rec bind k e =
554594match ewith
555595| Done x-> k x
556- | NotYetDone work-> NotYetDone( fun () -> ( work() ))
596+ | NotYetDone work-> NotYetDone( fun ctok -> bind k( work ctok ))
557597
558598let fold f acc seq =
559599( Done acc, seq) ||> Seq.fold( fun acc x -> acc|> bind( fun acc -> f acc x))
@@ -562,13 +602,13 @@ module Eventually =
562602match ewith
563603| Done x-> Done( Result x)
564604| NotYetDone work->
565- NotYetDone( fun () ->
566- let res = try Result( work() )with | e-> Exception e
605+ NotYetDone( fun ctok ->
606+ let res = try Result( work ctok ) with | e-> Exception e
567607match reswith
568608| Result cont-> catch cont
569609| Exception e-> Done( Exception e))
570610
571- let delay f = NotYetDone( fun () -> ())
611+ let delay ( f : unit -> Eventually < 'T >) = NotYetDone( fun _ctok -> f())
572612
573613let tryFinally e compensation =
574614 catch( e)
@@ -581,6 +621,10 @@ module Eventually =
581621 catch e
582622|> bind( function Result v-> Done v| Exception e-> handler e)
583623
624+ // All eventually computations carry a CompiationThreadToken
625+ let token =
626+ NotYetDone( fun ctok -> Done ctok)
627+
584628type EventuallyBuilder () =
585629member x.Bind ( e , k ) = Eventually.bind k e
586630member x.Return ( v ) = Eventually.Done v