diff --git a/docs/fcs/queue.fsx b/docs/fcs/queue.fsx index 88a5af258ec..bc9e8595b5d 100644 --- a/docs/fcs/queue.fsx +++ b/docs/fcs/queue.fsx @@ -9,47 +9,66 @@ This is a design note on the FSharpChecker component and its operations queue. FSharpChecker maintains an operations queue. Items from the FSharpChecker operations queue are processed sequentially and in order. -The thread processing these requests can also run a low-priority, interleaved background operation when the -queue is empty. This can be used to implicitly bring the background check of a project "up-to-date". -When the operations queue has been empty for 1 second, -this background work is run in small incremental fragments. This work is cooperatively time-sliced to be approximately <50ms, (see `maxTimeShareMilliseconds` in -IncrementalBuild.fs). The project to be checked in the background is set implicitly -by calls to ``CheckFileInProject`` and ``ParseAndCheckFileInProject``. -To disable implicit background checking completely, set ``checker.ImplicitlyStartBackgroundWork`` to false. -To change the time before background work starts, set ``checker.PauseBeforeBackgroundWork`` to the required number of milliseconds. - -Most calls to the FSharpChecker API enqueue an operation in the FSharpChecker compiler queue. These correspond to the -calls to EnqueueAndAwaitOpAsync in [service.fs](https://github.com/fsharp/FSharp.Compiler.Service/blob/master/src/fsharp/service/service.fs). - -* For example, calling `ParseAndCheckProject` enqueues a `ParseAndCheckProjectImpl` operation. The time taken for the +This means the FCS API has three kinds of operations: + +* "Runs on caller thread (runs on caller thread)" - Some requests from FSharp.Editor are + serviced concurrently without using the queue at all. Everything without an Async return type + is in this category. + +* "Queued-at-high-priority (runs on reactor thread)" - These are requests made via the FCS API + (e.g. from FSharp.Editor) and anything with "Async" return type is in this category. The + originating calls are not typically on the UI thread and are associated with active actions + by the user (editing a file etc.). + + These correspond to the calls to EnqueueAndAwaitOpAsync in [service.fs](https://github.com/fsharp/FSharp.Compiler.Service/blob/master/src/fsharp/service/service.fs). + For example, calling `ParseAndCheckProject` enqueues a `ParseAndCheckProjectImpl` operation. The time taken for the operation will depend on how much work is required to bring the project analysis up-to-date. + The length of the operation will vary - many will be very fast - but they won't + be processed until other operations already in the queue are complete. -* Likewise, calling any of `GetUsesOfSymbol`, `GetAllUsesOfAllSymbols`, `ParseFileInProject`, - `GetBackgroundParseResultsForFileInProject`, `MatchBraces`, `CheckFileInProjectIfReady`, `ParseAndCheckFileInProject`, `GetBackgroundCheckResultsForFileInProject`, - `ParseAndCheckProject`, `GetProjectOptionsFromScript`, `InvalidateConfiguration`, `InvaidateAll` and operations - on FSharpCheckResults will cause an operation to be enqueued. The length of the operation will - vary - many will be very fast - but they won't be processed until other operations already in the queue are complete. +* "Queued and interleaved at lower priority (runs on reactor thread)" - This is reserved + for a "background" job (CheckProjectInBackground) used for to prepare the project builder + state of the current project being worked on. The "background" work is intended to be + divided into little chunks so it can always be interrupted in order to service the higher-priority work. -Some operations do not enqueue anything on the FSharpChecker operations queue - notably any accesses to the Symbol APIs. -These use cross-threaded access to the TAST data produced by other FSharpChecker operations. + This operation runs when the queue is empty. When the operations queue has been empty for 1 second, + this work is run in small incremental fragments. The overall work may get cancelled if replaced + by an alternative project build. This work is cooperatively + time-sliced to be approximately <50ms, (see `maxTimeShareMilliseconds` in + IncrementalBuild.fs). The project to be checked in the background is set implicitly + by calls to ``CheckFileInProject`` and ``ParseAndCheckFileInProject``. + To disable implicit background checking completely, set ``checker.ImplicitlyStartBackgroundWork`` to false. + To change the time before background work starts, set ``checker.PauseBeforeBackgroundWork`` to the required + number of milliseconds. -Some tools throw a lot of interactive work at the FSharpChecker operations queue. +Some tools throw a lot of "Queued-at-high-priority" work at the FSharpChecker operations queue. If you are writing such a component, consider running your project against a debug build of FSharp.Compiler.Service.dll to see the Trace.WriteInformation messages indicating the length of the operations queue and the time to process requests. For those writing interactive editors which use FCS, you -should be cautious about operations that request a check of the entire project. +should be cautious about long running "Queued-at-high-priority" operations - these +will run in preference to other similar operations and must be both asynchronous +and cancelled if the results will no longer be needed. For example, be careful about requesting the check of an entire project on operations like "Highlight Symbol" or "Find Unused Declarations" (which run automatically when the user opens a file or moves the cursor). as opposed to operations like "Find All References" (which a user explicitly triggers). -Project checking can cause long and contention on the FSharpChecker operations queue. +Project checking can cause long and contention on the FSharpChecker operations queue. You *must* +cancel such operations if the results will be out-of-date, in order for your editing tools to be performant. -Requests to FCS can be cancelled by cancelling the async operation. (Some requests also +Requests can be cancelled via the cancellation token of the async operation. (Some requests also include additional callbacks which can be used to indicate a cancellation condition). -This cancellation will be effective if the cancellation is performed before the operation -is executed in the operations queue. +If the operation has not yet started it will remain in the queue and be discarded when it reaches the front. + +The long term intent of FCS is to eventually remove the reactor thread and the operations queue. However the queue +has several operational impacts we need to be mindful of + +1. It acts as a brake on the overall resource usage (if 1000 requests get made from FSharp.Editor they are serviced one at a time, and the work is not generally repeated as it get cached). + +2. It potentially acts as a data-lock on the project builder compilation state. + +3. It runs the low-priority project build. Summary ------- diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index 92e45f30a31..3835ae3ec64 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -5,6 +5,7 @@ module internal FSharp.Compiler.ParseAndCheckInputs open System open System.IO +open System.Threading open Internal.Utilities open Internal.Utilities.Collections @@ -757,9 +758,6 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig: TcConfig, tcImports: eventually { try - let! ctok = Eventually.token - RequireCompilationThread ctok // Everything here requires the compilation thread since it works on the TAST - CheckSimulateException tcConfig let m = inp.Range @@ -883,8 +881,13 @@ let TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, pre // 'use' ensures that the warning handler is restored at the end use unwindEL = PushErrorLoggerPhaseUntilUnwind(fun oldLogger -> GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput inp, oldLogger) ) use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck + + RequireCompilationThread ctok TypeCheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, inp, false) - |> Eventually.force ctok + |> Eventually.force CancellationToken.None + |> function + | ValueOrCancelled.Value v -> v + | ValueOrCancelled.Cancelled ce -> raise ce // this condition is unexpected, since CancellationToken.None was passed /// Finish checking multiple files (or one interactive entry into F# Interactive) let TypeCheckMultipleInputsFinish(results, tcState: TcState) = diff --git a/src/fsharp/SyntaxTree.fsi b/src/fsharp/SyntaxTree.fsi index efe5bcf47c6..f2c0f6e0893 100644 --- a/src/fsharp/SyntaxTree.fsi +++ b/src/fsharp/SyntaxTree.fsi @@ -11,10 +11,12 @@ type Ident = new: text: string * range: range -> Ident member idText: string member idRange: range + /// Represents a long identifier e.g. 'A.B.C' type LongIdent = Ident list + /// Represents a long identifier with possible '.' at end. /// /// Typically dotRanges.Length = lid.Length-1, but they may be same if (incomplete) code ends in a dot, e.g. "Foo.Bar." diff --git a/src/fsharp/absil/illib.fs b/src/fsharp/absil/illib.fs index 07fa43490a2..fa0fb872aa7 100644 --- a/src/fsharp/absil/illib.fs +++ b/src/fsharp/absil/illib.fs @@ -637,6 +637,7 @@ type ExecutionToken = interface end /// /// Like other execution tokens this should be passed via argument passing and not captured/stored beyond /// the lifetime of stack-based calls. This is not checked, it is a discipline within the compiler code. +[] type CompilationThreadToken() = interface ExecutionToken /// A base type for various types of tokens that must be passed when a lock is taken. @@ -644,6 +645,7 @@ type CompilationThreadToken() = interface ExecutionToken type LockToken = inherit ExecutionToken /// Represents a token that indicates execution on any of several potential user threads calling the F# compiler services. +[] type AnyCallerThreadToken() = interface ExecutionToken [] @@ -674,9 +676,10 @@ type Lock<'LockTokenType when 'LockTokenType :> LockToken>() = module Map = let tryFindMulti k map = match Map.tryFind k map with Some res -> res | None -> [] +[] type ResultOrException<'TResult> = - | Result of 'TResult - | Exception of Exception + | Result of result: 'TResult + | Exception of ``exception``: Exception module ResultOrException = @@ -700,10 +703,10 @@ module ResultOrException = | Result x -> success x | Exception _err -> f() -[] +[] type ValueOrCancelled<'TResult> = - | Value of 'TResult - | Cancelled of OperationCanceledException + | Value of result: 'TResult + | Cancelled of ``exception``: OperationCanceledException /// Represents a cancellable computation with explicit representation of a cancelled result. /// @@ -722,21 +725,21 @@ module Cancellable = oper ct /// Bind the result of a cancellable computation - let bind f comp1 = + let inline bind f comp1 = Cancellable (fun ct -> match run ct comp1 with | ValueOrCancelled.Value v1 -> run ct (f v1) | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1) /// Map the result of a cancellable computation - let map f oper = + let inline map f oper = Cancellable (fun ct -> match run ct oper with | ValueOrCancelled.Value res -> ValueOrCancelled.Value (f res) | ValueOrCancelled.Cancelled err -> ValueOrCancelled.Cancelled err) /// Return a simple value as the result of a cancellable computation - let ret x = Cancellable (fun _ -> ValueOrCancelled.Value x) + let inline ret x = Cancellable (fun _ -> ValueOrCancelled.Value x) /// Fold a cancellable computation along a sequence of inputs let fold f acc seq = @@ -748,22 +751,11 @@ module Cancellable = | res -> res)) /// Iterate a cancellable computation over a collection - let each f seq = - Cancellable (fun ct -> - (ValueOrCancelled.Value [], seq) - ||> Seq.fold (fun acc x -> - match acc with - | ValueOrCancelled.Value acc -> - match run ct (f x) with - | ValueOrCancelled.Value x2 -> ValueOrCancelled.Value (x2 :: acc) - | ValueOrCancelled.Cancelled err1 -> ValueOrCancelled.Cancelled err1 - | canc -> canc) - |> function - | ValueOrCancelled.Value acc -> ValueOrCancelled.Value (List.rev acc) - | canc -> canc) + let inline each f seq = + fold (fun acc x -> f x |> map (fun y -> (y :: acc))) [] seq |> map List.rev /// Delay a cancellable computation - let delay (f: unit -> Cancellable<'T>) = Cancellable (fun ct -> let (Cancellable g) = f() in g ct) + let inline delay (f: unit -> Cancellable<'T>) = Cancellable (fun ct -> let (Cancellable g) = f() in g ct) /// Run the computation in a mode where it may not be cancelled. The computation never results in a /// ValueOrCancelled.Cancelled. @@ -773,6 +765,16 @@ module Cancellable = | ValueOrCancelled.Cancelled _ -> failwith "unexpected cancellation" | ValueOrCancelled.Value r -> r + let toAsync c = + async { + let! ct = Async.CancellationToken + let res = run ct c + return! Async.FromContinuations (fun (cont, _econt, ccont) -> + match res with + | ValueOrCancelled.Value v -> cont v + | ValueOrCancelled.Cancelled ce -> ccont ce) + } + /// Bind the cancellation token associated with the computation let token () = Cancellable (fun ct -> ValueOrCancelled.Value ct) @@ -780,157 +782,188 @@ module Cancellable = let canceled() = Cancellable (fun ct -> ValueOrCancelled.Cancelled (OperationCanceledException ct)) /// Catch exceptions in a computation - let private catch (Cancellable e) = + let inline catch e = + let (Cancellable f) = e Cancellable (fun ct -> try - match e ct with + match f ct with | ValueOrCancelled.Value r -> ValueOrCancelled.Value (Choice1Of2 r) | ValueOrCancelled.Cancelled e -> ValueOrCancelled.Cancelled e with err -> ValueOrCancelled.Value (Choice2Of2 err)) /// Implement try/finally for a cancellable computation - let tryFinally e compensation = + let inline tryFinally e compensation = catch e |> bind (fun res -> compensation() match res with Choice1Of2 r -> ret r | Choice2Of2 err -> raise err) /// Implement try/with for a cancellable computation - let tryWith e handler = + let inline tryWith e handler = catch e |> bind (fun res -> match res with Choice1Of2 r -> ret r | Choice2Of2 err -> handler err) - // Run the cancellable computation within an Async computation. This isn't actually used in the codebase, but left - // here in case we need it in the future - // - // let toAsync e = - // async { - // let! ct = Async.CancellationToken - // return! - // Async.FromContinuations(fun (cont, econt, ccont) -> - // // Run the computation synchronously using the given cancellation token - // let res = try Choice1Of2 (run ct e) with err -> Choice2Of2 err - // match res with - // | Choice1Of2 (ValueOrCancelled.Value v) -> cont v - // | Choice1Of2 (ValueOrCancelled.Cancelled err) -> ccont err - // | Choice2Of2 err -> econt err) - // } - type CancellableBuilder() = - member x.Bind(e, k) = Cancellable.bind k e + member inline _.BindReturn(e, k) = Cancellable.map k e + + member inline _.Bind(e, k) = Cancellable.bind k e - member x.Return v = Cancellable.ret v + member inline _.Return v = Cancellable.ret v - member x.ReturnFrom v = v + member inline _.ReturnFrom (v: Cancellable<'T>) = v - member x.Combine(e1, e2) = e1 |> Cancellable.bind (fun () -> e2) + member inline _.Combine(e1, e2) = e1 |> Cancellable.bind (fun () -> e2) - member x.For(es, f) = es |> Cancellable.each f + member inline _.For(es, f) = es |> Cancellable.each f - member x.TryWith(e, handler) = Cancellable.tryWith e handler + member inline _.TryWith(e, handler) = Cancellable.tryWith e handler - member x.Using(resource, e) = Cancellable.tryFinally (e resource) (fun () -> (resource :> IDisposable).Dispose()) + member inline _.Using(resource, e) = Cancellable.tryFinally (e resource) (fun () -> (resource :> IDisposable).Dispose()) - member x.TryFinally(e, compensation) = Cancellable.tryFinally e compensation + member inline _.TryFinally(e, compensation) = Cancellable.tryFinally e compensation - member x.Delay f = Cancellable.delay f + member inline _.Delay f = Cancellable.delay f - member x.Zero() = Cancellable.ret () + member inline _.Zero() = Cancellable.ret () [] module CancellableAutoOpens = let cancellable = CancellableBuilder() -/// Computations that can cooperatively yield by returning a continuation +/// Computations that can cooperatively yield /// -/// - Any yield of a NotYetDone should typically be "abandonable" without adverse consequences. No resource release -/// will be called when the computation is abandoned. -/// -/// - Computations suspend via a NotYetDone may use local state (mutables), where these are -/// captured by the NotYetDone closure. Computations do not need to be restartable. -/// -/// - The key thing is that you can take an Eventually value and run it with -/// Eventually.repeatedlyProgressUntilDoneOrTimeShareOverOrCanceled -/// -/// - Cancellation results in a suspended computation rather than complete abandonment +/// - You can take an Eventually value and run it with Eventually.forceForTimeSlice type Eventually<'T> = | Done of 'T - | NotYetDone of (CompilationThreadToken -> Eventually<'T>) + | NotYetDone of (CancellationToken -> (Stopwatch * int64) option -> ValueOrCancelled>) + // Indicates an IDisposable should be created and disposed on each step(s) + | Delimited of (unit -> IDisposable) * Eventually<'T> module Eventually = - let rec box e = - match e with - | Done x -> Done (Operators.box x) - | NotYetDone work -> NotYetDone (fun ctok -> box (work ctok)) - - let rec forceWhile ctok check e = - match e with - | Done x -> Some x - | NotYetDone work -> - if not(check()) - then None - else forceWhile ctok check (work ctok) + let inline ret x = Done x - let force ctok e = Option.get (forceWhile ctok (fun () -> true) e) - - /// Keep running the computation bit by bit until a time limit is reached. - /// The runner gets called each time the computation is restarted - /// - /// If cancellation happens, the operation is left half-complete, ready to resume. - let repeatedlyProgressUntilDoneOrTimeShareOverOrCanceled timeShareInMilliseconds (ct: CancellationToken) runner e = - let sw = new Stopwatch() - let rec runTimeShare ctok e = - runner ctok (fun ctok -> - sw.Reset() - sw.Start() - let rec loop ctok ev2 = - match ev2 with - | Done _ -> ev2 - | NotYetDone work -> - if ct.IsCancellationRequested || sw.ElapsedMilliseconds > timeShareInMilliseconds then - sw.Stop() - NotYetDone(fun ctok -> runTimeShare ctok ev2) - else - loop ctok (work ctok) - loop ctok e) - NotYetDone (fun ctok -> runTimeShare ctok e) + // Convert to a Cancellable which, when run, takes all steps in the computation, + // installing Delimited resource handlers if needed. + // + // Inlined for better stack traces, because inlining erases library ranges and replaces them + // with ranges in user code. + let inline toCancellable e = + Cancellable (fun ct -> + let rec toCancellableAux e = + match e with + | Done x -> ValueOrCancelled.Value x + | Delimited (resourcef, ev2) -> + use _resource = resourcef() + toCancellableAux ev2 + | NotYetDone work -> + if ct.IsCancellationRequested then + ValueOrCancelled.Cancelled (OperationCanceledException ct) + else + match work ct None with + | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce + | ValueOrCancelled.Value e2 -> toCancellableAux e2 + toCancellableAux e) + + // Inlined for better stack traces, because inlining replaces ranges of the "runtime" code in the lambda + // with ranges in user code. + let inline ofCancellable (Cancellable f) = + NotYetDone (fun ct _ -> + match f ct with + | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce + | ValueOrCancelled.Value v -> ValueOrCancelled.Value (Done v) + ) + + let token () = NotYetDone (fun ct _ -> ValueOrCancelled.Value (Done ct)) + + let canceled () = NotYetDone (fun ct _ -> ValueOrCancelled.Cancelled (OperationCanceledException ct)) + + // Take all steps in the computation, installing Delimited resource handlers if needed + let force ct e = Cancellable.run ct (toCancellable e) + + let stepCheck (ct: CancellationToken) (swinfo: (Stopwatch * int64) option) e = + if ct.IsCancellationRequested then + match swinfo with Some (sw, _) -> sw.Stop() | _ -> () + ValueSome (ValueOrCancelled.Cancelled (OperationCanceledException(ct))) + else + match swinfo with + | Some (sw, timeShareInMilliseconds) when sw.ElapsedMilliseconds > timeShareInMilliseconds -> + sw.Stop() + ValueSome (ValueOrCancelled.Value e) + | _ -> + ValueNone + + // Take multiple steps in the computation, installing Delimited resource handlers if needed, + // until the stopwatch times out if present. + [] + let rec steps (ct: CancellationToken) (swinfo: (Stopwatch * int64) option) e = + match stepCheck ct swinfo e with + | ValueSome res -> res + | ValueNone -> + match e with + | Done _ -> ValueOrCancelled.Value e + | Delimited (resourcef, inner) -> + use _resource = resourcef() + match steps ct swinfo inner with + | ValueOrCancelled.Value (Done _ as res) -> ValueOrCancelled.Value res + | ValueOrCancelled.Value inner2 -> ValueOrCancelled.Value (Delimited (resourcef, inner2)) // maintain the Delimited until Done + | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce + | NotYetDone work -> + match work ct swinfo with + | ValueOrCancelled.Value e2 -> steps ct swinfo e2 + | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce + + // Take multiple steps in the computation, installing Delimited resource handlers if needed + let forceForTimeSlice (sw: Stopwatch) timeShareInMilliseconds (ct: CancellationToken) e = + sw.Restart() + let swinfo = Some (sw, timeShareInMilliseconds) + steps ct swinfo e + + // Inlined for better stack traces, because inlining replaces ranges of the "runtime" code in the lambda + // with ranges in user code. + let inline bind k e = + let rec bindAux e = + NotYetDone (fun ct swinfo -> + let v = steps ct swinfo e + match v with + | ValueOrCancelled.Value (Done v) -> ValueOrCancelled.Value (k v) + | ValueOrCancelled.Value e2 -> ValueOrCancelled.Value (bindAux e2) + | ValueOrCancelled.Cancelled ce -> ValueOrCancelled.Cancelled ce) + bindAux e + + // Inlined for better stack traces, because inlining replaces ranges of the "runtime" code in the lambda + // with ranges in user code. + let inline map f e = bind (f >> ret) e - /// Keep running the asynchronous computation bit by bit. The runner gets called each time the computation is restarted. - /// Can be cancelled as an Async in the normal way. - let forceAsync (runner: (CompilationThreadToken -> Eventually<'T>) -> Async>) (e: Eventually<'T>) : Async<'T option> = - let rec loop (e: Eventually<'T>) = - async { - match e with - | Done x -> return Some x - | NotYetDone work -> - let! r = runner work - return! loop r - } - loop e - - let rec bind k e = - match e with - | Done x -> k x - | NotYetDone work -> NotYetDone (fun ctok -> bind k (work ctok)) - - let fold f acc seq = + // Inlined for better stack traces, because inlining replaces ranges of the "runtime" code in the lambda + // with ranges in user code. + let inline fold f acc seq = (Done acc, seq) ||> Seq.fold (fun acc x -> acc |> bind (fun acc -> f acc x)) - let rec catch e = - match e with - | Done x -> Done(Result x) - | NotYetDone work -> - NotYetDone (fun ctok -> - let res = try Result(work ctok) with | e -> Exception e - match res with - | Result cont -> catch cont - | Exception e -> Done(Exception e)) + // Inlined for better stack traces, because inlining replaces ranges of the "runtime" code in the lambda + // with ranges in user code. + let inline each f seq = + fold (fun acc x -> f x |> map (fun y -> y :: acc)) [] seq |> map List.rev + + // Catch by pushing exception handlers around all the work + let inline catch e = + let rec catchAux e = + match e with + | Done x -> Done(Result x) + | Delimited (resourcef, ev2) -> Delimited (resourcef, catchAux ev2) + | NotYetDone work -> + NotYetDone (fun ct swinfo -> + let res = try Result(work ct swinfo) with exn -> Exception exn + match res with + | Result (ValueOrCancelled.Value cont) -> ValueOrCancelled.Value (catchAux cont) + | Result (ValueOrCancelled.Cancelled ce) -> ValueOrCancelled.Cancelled ce + | Exception exn -> ValueOrCancelled.Value (Done(Exception exn))) + catchAux e - let delay (f: unit -> Eventually<'T>) = NotYetDone (fun _ctok -> f()) + let inline delay f = NotYetDone (fun _ct _swinfo -> ValueOrCancelled.Value (f ())) - let tryFinally e compensation = + let inline tryFinally e compensation = catch e |> bind (fun res -> compensation() @@ -938,31 +971,34 @@ module Eventually = | Result v -> Eventually.Done v | Exception e -> raise e) - let tryWith e handler = + let inline tryWith e handler = catch e |> bind (function Result v -> Done v | Exception e -> handler e) - // All eventually computations carry a CompilationThreadToken - let token = - NotYetDone (fun ctok -> Done ctok) - + let box e = map Operators.box e + + let reusing resourcef e = Eventually.Delimited(resourcef, e) + + type EventuallyBuilder() = - member x.Bind(e, k) = Eventually.bind k e + member inline _.BindReturn(e, k) = Eventually.map k e + + member inline _.Bind(e, k) = Eventually.bind k e - member x.Return v = Eventually.Done v + member inline _.Return v = Eventually.Done v - member x.ReturnFrom v = v + member inline _.ReturnFrom v = v - member x.Combine(e1, e2) = e1 |> Eventually.bind (fun () -> e2) + member inline _.Combine(e1, e2) = e1 |> Eventually.bind (fun () -> e2) - member x.TryWith(e, handler) = Eventually.tryWith e handler + member inline _.TryWith(e, handler) = Eventually.tryWith e handler - member x.TryFinally(e, compensation) = Eventually.tryFinally e compensation + member inline _.TryFinally(e, compensation) = Eventually.tryFinally e compensation - member x.Delay f = Eventually.delay f + member inline _.Delay f = Eventually.delay f - member x.Zero() = Eventually.Done () + member inline _.Zero() = Eventually.Done () [] module internal EventuallyAutoOpens = @@ -1022,7 +1058,7 @@ type LazyWithContextFailure(exn: exn) = static let undefined = new LazyWithContextFailure(UndefinedException) - member x.Exception = exn + member _.Exception = exn static member Undefined = undefined diff --git a/src/fsharp/absil/illib.fsi b/src/fsharp/absil/illib.fsi index c63bc2a1b10..57e8593f730 100644 --- a/src/fsharp/absil/illib.fsi +++ b/src/fsharp/absil/illib.fsi @@ -5,6 +5,7 @@ namespace Internal.Utilities.Library open System open System.Threading open System.Collections.Generic +open System.Diagnostics open System.Runtime.CompilerServices [] @@ -275,12 +276,14 @@ type internal ExecutionToken = interface end /// /// Like other execution tokens this should be passed via argument passing and not captured/stored beyond /// the lifetime of stack-based calls. This is not checked, it is a discipline within the compiler code. +[] type internal CompilationThreadToken = interface ExecutionToken new: unit -> CompilationThreadToken /// Represents a token that indicates execution on any of several potential user threads calling the F# compiler services. +[] type internal AnyCallerThreadToken = interface ExecutionToken @@ -320,9 +323,10 @@ module internal Map = val tryFindMulti : k:'a -> map:Map<'a,'b list> -> 'b list when 'a: comparison +[] type internal ResultOrException<'TResult> = - | Result of 'TResult - | Exception of Exception + | Result of result: 'TResult + | Exception of ``exception``: Exception module internal ResultOrException = @@ -336,10 +340,10 @@ module internal ResultOrException = val otherwise : f:(unit -> ResultOrException<'a>) -> x:ResultOrException<'a> -> ResultOrException<'a> -[] +[] type internal ValueOrCancelled<'TResult> = - | Value of 'TResult - | Cancelled of OperationCanceledException + | Value of result: 'TResult + | Cancelled of ``exception``: OperationCanceledException /// Represents a synchronous cancellable computation with explicit representation of a cancelled result. /// @@ -355,22 +359,22 @@ module internal Cancellable = val run : ct:CancellationToken -> Cancellable<'a> -> ValueOrCancelled<'a> /// Bind the result of a cancellable computation - val bind : f:('a -> Cancellable<'b>) -> comp1:Cancellable<'a> -> Cancellable<'b> + val inline bind : f:('a -> Cancellable<'b>) -> comp1:Cancellable<'a> -> Cancellable<'b> /// Map the result of a cancellable computation - val map: f:('a -> 'b) -> oper:Cancellable<'a> -> Cancellable<'b> + val inline map: f:('a -> 'b) -> oper:Cancellable<'a> -> Cancellable<'b> /// Return a simple value as the result of a cancellable computation - val ret: x:'a -> Cancellable<'a> + val inline ret: x:'a -> Cancellable<'a> /// Fold a cancellable computation along a sequence of inputs val fold : f:('a -> 'b -> Cancellable<'a>) -> acc:'a -> seq:seq<'b> -> Cancellable<'a> /// Iterate a cancellable computation over a collection - val each : f:('a -> Cancellable<'b>) -> seq:seq<'a> -> Cancellable<'b list> + val inline each : f:('a -> Cancellable<'b>) -> seq:seq<'a> -> Cancellable<'b list> /// Delay a cancellable computation - val delay: f:(unit -> Cancellable<'T>) -> Cancellable<'T> + val inline delay: f:(unit -> Cancellable<'T>) -> Cancellable<'T> /// Run the computation in a mode where it may not be cancelled. The computation never results in a /// ValueOrCancelled.Cancelled. @@ -383,111 +387,138 @@ module internal Cancellable = val canceled: unit -> Cancellable<'a> /// Implement try/finally for a cancellable computation - val tryFinally : e:Cancellable<'a> -> compensation:(unit -> unit) -> Cancellable<'a> + val inline catch : e:Cancellable<'a> -> Cancellable> + + /// Implement try/finally for a cancellable computation + val inline tryFinally : e:Cancellable<'a> -> compensation:(unit -> unit) -> Cancellable<'a> /// Implement try/with for a cancellable computation - val tryWith : e:Cancellable<'a> -> handler:(exn -> Cancellable<'a>) -> Cancellable<'a> + val inline tryWith : e:Cancellable<'a> -> handler:(exn -> Cancellable<'a>) -> Cancellable<'a> + + val toAsync: Cancellable<'a> -> Async<'a> type internal CancellableBuilder = new: unit -> CancellableBuilder - member Bind: e:Cancellable<'k> * k:('k -> Cancellable<'l>) -> Cancellable<'l> + member inline BindReturn: e:Cancellable<'T> * k:('T -> 'U) -> Cancellable<'U> + + member inline Bind: e:Cancellable<'T> * k:('T -> Cancellable<'U>) -> Cancellable<'U> - member Combine: e1:Cancellable * e2:Cancellable<'h> -> Cancellable<'h> + member inline Combine: e1:Cancellable * e2:Cancellable<'T> -> Cancellable<'T> - member Delay: f:(unit -> Cancellable<'a>) -> Cancellable<'a> + member inline Delay: f:(unit -> Cancellable<'T>) -> Cancellable<'T> - member For: es:seq<'f> * f:('f -> Cancellable<'g>) -> Cancellable<'g list> + member inline For: es:seq<'T> * f:('T -> Cancellable<'U>) -> Cancellable<'U list> - member Return: v:'j -> Cancellable<'j> + member inline Return: v:'T -> Cancellable<'T> - member ReturnFrom: v:'i -> 'i + member inline ReturnFrom: v:Cancellable<'T> -> Cancellable<'T> - member TryFinally: e:Cancellable<'b> * compensation:(unit -> unit) -> Cancellable<'b> + member inline TryFinally: e:Cancellable<'T> * compensation:(unit -> unit) -> Cancellable<'T> - member TryWith: e:Cancellable<'e> * handler:(exn -> Cancellable<'e>) -> Cancellable<'e> + member inline TryWith: e:Cancellable<'T> * handler:(exn -> Cancellable<'T>) -> Cancellable<'T> - member Using: resource:'c * e:('c -> Cancellable<'d>) -> Cancellable<'d> when 'c :> System.IDisposable + member inline Using: resource:'c * e:('c -> Cancellable<'T>) -> Cancellable<'T> when 'c :> System.IDisposable - member Zero: unit -> Cancellable + member inline Zero: unit -> Cancellable [] module internal CancellableAutoOpens = val cancellable: CancellableBuilder -/// Computations that can cooperatively yield by returning a continuation -/// -/// - Any yield of a NotYetDone should typically be "abandonable" without adverse consequences. No resource release -/// will be called when the computation is abandoned. -/// -/// - Computations suspend via a NotYetDone may use local state (mutables), where these are -/// captured by the NotYetDone closure. Computations do not need to be restartable. -/// -/// - The key thing is that you can take an Eventually value and run it with -/// Eventually.repeatedlyProgressUntilDoneOrTimeShareOverOrCanceled +/// Cancellable computations that can cooperatively yield /// -/// - Cancellation results in a suspended computation rather than complete abandonment -type internal Eventually<'T> = - | Done of 'T - | NotYetDone of (CompilationThreadToken -> Eventually<'T>) +/// - You can take an Eventually value and run it with Eventually.forceForTimeSlice +type internal Eventually<'T> = + | Done of 'T + | NotYetDone of (CancellationToken -> (Stopwatch * int64) option -> ValueOrCancelled>) + | Delimited of (unit -> IDisposable) * Eventually<'T> module internal Eventually = + /// Return a simple value as the result of an eventually computation + val inline ret: x:'a -> Eventually<'a> + val box: e:Eventually<'a> -> Eventually - val forceWhile : ctok:CompilationThreadToken -> check:(unit -> bool) -> e:Eventually<'a> -> 'a option + // Throws away time-slicing but retains cancellation + val inline toCancellable: e:Eventually<'T> -> Cancellable<'T> + + val inline ofCancellable: Cancellable<'T> -> Eventually<'T> + + val force: ct: CancellationToken -> e:Eventually<'a> -> ValueOrCancelled<'a> + + /// Run for at most the given time slice, returning the residue computation, which may be complete. + /// If cancellation is requested then just return the computation at the point where cancellation + /// was detected. + val forceForTimeSlice: sw:Stopwatch -> timeShareInMilliseconds: int64 -> ct: CancellationToken -> e: Eventually<'a> -> ValueOrCancelled> + + /// Check if cancellation or time limit has been reached. Needed for inlined combinators + val stepCheck: ct: CancellationToken -> swinfo: (Stopwatch * int64) option -> e:'T -> ValueOrCancelled<'T> voption - val force: ctok:CompilationThreadToken -> e:Eventually<'a> -> 'a + /// Take steps in the computation. Needed for inlined combinators. + [] + val steps: ct: CancellationToken -> swinfo: (Stopwatch * int64) option -> e:Eventually<'T> -> ValueOrCancelled> - /// Keep running the computation bit by bit until a time limit is reached. - /// The runner gets called each time the computation is restarted - /// - /// If cancellation happens, the operation is left half-complete, ready to resume. - val repeatedlyProgressUntilDoneOrTimeShareOverOrCanceled : - timeShareInMilliseconds:int64 -> - ct:CancellationToken -> - runner:(CompilationThreadToken -> (#CompilationThreadToken -> Eventually<'b>) -> Eventually<'b>) -> - e:Eventually<'b> - -> Eventually<'b> + // Inlined for better stack traces, replacing ranges of the "runtime" code in the lambdas with ranges in user code. + val inline map: f:('a -> 'b) -> e:Eventually<'a> -> Eventually<'b> - /// Keep running the asynchronous computation bit by bit. The runner gets called each time the computation is restarted. - /// Can be cancelled as an Async in the normal way. - val forceAsync : runner:((CompilationThreadToken -> Eventually<'T>) -> Async>) -> e:Eventually<'T> -> Async<'T option> + // Inlined for better stack traces, replacing ranges of the "runtime" code in the lambdas with ranges in user code. + val inline bind: k:('a -> Eventually<'b>) -> e:Eventually<'a> -> Eventually<'b> - val bind: k:('a -> Eventually<'b>) -> e:Eventually<'a> -> Eventually<'b> + /// Fold a computation over a collection + // + // Inlined for better stack traces, replacing ranges of the "runtime" code in the lambdas with ranges in user code. + val inline fold : f:('a -> 'b -> Eventually<'a>) -> acc:'a -> seq:seq<'b> -> Eventually<'a> - val fold : f:('a -> 'b -> Eventually<'a>) -> acc:'a -> seq:seq<'b> -> Eventually<'a> + /// Map a computation over a collection + // + // Inlined for better stack traces, replacing ranges of the "runtime" code in the lambdas with ranges in user code. + val inline each : f:('a -> Eventually<'b>) -> seq:seq<'a> -> Eventually<'b list> - val catch: e:Eventually<'a> -> Eventually> + // Inlined for better stack traces, replacing ranges of the "runtime" code in the lambdas with ranges in user code. + val inline catch: e:Eventually<'a> -> Eventually> - val delay: f:(unit -> Eventually<'T>) -> Eventually<'T> + // Inlined for better stack traces, replacing ranges of the "runtime" code in the lambdas with ranges in user code. + val inline delay: f:(unit -> Eventually<'T>) -> Eventually<'T> - val tryFinally : e:Eventually<'a> -> compensation:(unit -> unit) -> Eventually<'a> + // Inlined for better stack traces, replacing ranges of the "runtime" code in the lambdas with ranges in user code. + val inline tryFinally : e:Eventually<'a> -> compensation:(unit -> unit) -> Eventually<'a> - val tryWith : e:Eventually<'a> -> handler:(System.Exception -> Eventually<'a>) -> Eventually<'a> + // Inlined for better stack traces, replacing ranges of the "runtime" code in the lambdas with ranges in user code. + val inline tryWith : e:Eventually<'a> -> handler:(System.Exception -> Eventually<'a>) -> Eventually<'a> - // All eventually computations carry a CompilationThreadToken - val token: Eventually + /// Bind the cancellation token associated with the computation + val token: unit -> Eventually + + /// Represents a canceled computation + val canceled: unit -> Eventually<'a> + + /// Create the resource and install it on the stack each time the Eventually is restarted + val reusing: resourcef: (unit -> IDisposable) -> e:Eventually<'T> -> Eventually<'T> [] +// Inlined for better stack traces, replacing ranges of the "runtime" code in the lambdas with ranges in user code. type internal EventuallyBuilder = - member Bind: e:Eventually<'g> * k:('g -> Eventually<'h>) -> Eventually<'h> + member inline BindReturn: e:Eventually<'g> * k:('g -> 'h) -> Eventually<'h> + + member inline Bind: e:Eventually<'g> * k:('g -> Eventually<'h>) -> Eventually<'h> - member Combine: e1:Eventually * e2:Eventually<'d> -> Eventually<'d> + member inline Combine: e1:Eventually * e2:Eventually<'d> -> Eventually<'d> - member Delay: f:(unit -> Eventually<'a>) -> Eventually<'a> + member inline Delay: f:(unit -> Eventually<'a>) -> Eventually<'a> - member Return: v:'f -> Eventually<'f> + member inline Return: v:'f -> Eventually<'f> - member ReturnFrom: v:'e -> 'e + member inline ReturnFrom: v:'e -> 'e - member TryFinally: e:Eventually<'b> * compensation:(unit -> unit) -> Eventually<'b> + member inline TryFinally: e:Eventually<'b> * compensation:(unit -> unit) -> Eventually<'b> - member TryWith: e:Eventually<'c> * handler:(System.Exception -> Eventually<'c>) -> Eventually<'c> + member inline TryWith: e:Eventually<'c> * handler:(System.Exception -> Eventually<'c>) -> Eventually<'c> - member Zero: unit -> Eventually + member inline Zero: unit -> Eventually [] module internal EventuallyAutoOpens = diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 303f20e8439..cd848d1bba7 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -2663,10 +2663,10 @@ type internal FsiInteractionProcessor let names = names |> List.filter (fun name -> name.StartsWithOrdinal(stem)) names - member _.ParseAndCheckInteraction (ctok, legacyReferenceResolver, checker, istate, text:string) = + member _.ParseAndCheckInteraction (ctok, legacyReferenceResolver, istate, text:string) = let tcConfig = TcConfig.Create(tcConfigB,validate=false) - let fsiInteractiveChecker = FsiInteractiveChecker(legacyReferenceResolver, checker, tcConfig, istate.tcGlobals, istate.tcImports, istate.tcState) + let fsiInteractiveChecker = FsiInteractiveChecker(legacyReferenceResolver, tcConfig, istate.tcGlobals, istate.tcImports, istate.tcState) fsiInteractiveChecker.ParseAndCheckInteraction(ctok, SourceText.ofString text) @@ -2748,7 +2748,6 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i // To support fsi usage, the console coloring is switched off by default on Mono. do if runningOnMono then enableConsoleColoring <- false - //---------------------------------------------------------------------------- // tcConfig - build the initial config //---------------------------------------------------------------------------- @@ -2941,7 +2940,8 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i member x.ParseAndCheckInteraction(code) = let ctok = AssumeCompilationThreadWithoutEvidence () - fsiInteractionProcessor.ParseAndCheckInteraction (ctok, legacyReferenceResolver, checker.ReactorOps, fsiInteractionProcessor.CurrentState, code) + fsiInteractionProcessor.ParseAndCheckInteraction (ctok, legacyReferenceResolver, fsiInteractionProcessor.CurrentState, code) + |> Cancellable.runWithoutCancellation member x.InteractiveChecker = checker @@ -2950,6 +2950,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i member x.DynamicAssembly = fsiDynamicCompiler.DynamicAssembly + /// A host calls this to determine if the --gui parameter is active member x.IsGui = fsiOptions.Gui diff --git a/src/fsharp/fsi/fsi.fsi b/src/fsharp/fsi/fsi.fsi index d917815ca91..ba3bfc149cd 100644 --- a/src/fsharp/fsi/fsi.fsi +++ b/src/fsharp/fsi/fsi.fsi @@ -229,10 +229,7 @@ type FsiEvaluationSession = /// check brace matching and other information. /// /// Operations may be run concurrently with other requests to the InteractiveChecker. - /// - /// Due to a current limitation, it is not fully thread-safe to run this operation concurrently with evaluation triggered - /// by input from 'stdin'. - member ParseAndCheckInteraction: code: string -> Async + member ParseAndCheckInteraction: code: string -> FSharpParseFileResults * FSharpCheckFileResults * FSharpCheckProjectResults /// The single, global interactive checker to use in conjunction with other operations /// on the FsiEvaluationSession. diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index 42273fbacae..6455329fade 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -20,6 +20,7 @@ open FSharp.Compiler.ParseHelpers open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.SyntaxTreeOps +open FSharp.Compiler.SyntaxTreeOps open FSharp.Compiler.Text open FSharp.Compiler.Text.Position open FSharp.Compiler.Text.Range diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index 081e08874bb..3690154175d 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -105,14 +105,6 @@ module internal FSharpCheckerResultsSettings = let maxTypeCheckErrorsOutOfProjectContext = GetEnvInteger "FCS_MaxErrorsOutOfProjectContext" 3 - /// Maximum time share for a piece of background work before it should (cooperatively) yield - /// to enable other requests to be serviced. Yielding means returning a continuation function - /// (via an Eventually<_> value of case NotYetDone) that can be called as the next piece of work. - let maxTimeShareMilliseconds = - match System.Environment.GetEnvironmentVariable("FCS_MaxTimeShare") with - | null | "" -> 100L - | s -> int64 s - // Look for DLLs in the location of the service DLL first. let defaultFSharpBinariesDir = FSharpEnvironment.BinFolderOfDefaultFSharpCompiler(Some(Path.GetDirectoryName(typeof.Assembly.Location))).Value @@ -1735,10 +1727,9 @@ module internal ParseAndCheckFile = loadClosure: LoadClosure option, // These are the errors and warnings seen by the background compiler for the entire antecedent backgroundDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity)[], - reactorOps: IReactorOperations, - userOpName: string, - suggestNamesForErrors: bool) = async { + suggestNamesForErrors: bool) = + cancellable { use _logBlock = Logger.LogBlock LogCompilerFunctionId.Service_CheckOneFile let parsedMainInput = parseResults.ParseTree @@ -1756,7 +1747,7 @@ module internal ParseAndCheckFile = errHandler.ErrorSeverityOptions <- tcConfig.errorSeverityOptions // Play background errors and warnings for this file. - for err, severity in backgroundDiagnostics do + do for err, severity in backgroundDiagnostics do diagnosticSink (err, severity) // If additional references were brought in by the preprocessor then we need to process them @@ -1770,10 +1761,8 @@ module internal ParseAndCheckFile = // Typecheck the real input. let sink = TcResultsSinkImpl(tcGlobals, sourceText = sourceText) - let! ct = Async.CancellationToken - let! resOpt = - async { + cancellable { try let checkForErrors() = (parseResults.ParseHadErrors || errHandler.ErrorCount > 0) @@ -1782,33 +1771,23 @@ module internal ParseAndCheckFile = // Typecheck is potentially a long running operation. We chop it up here with an Eventually continuation and, at each slice, give a chance // for the client to claim the result as obsolete and have the typecheck abort. + use _unwind = new CompilationGlobalsScope (errHandler.ErrorLogger, BuildPhase.TypeCheck) let! result = TypeCheckOneInputAndFinishEventually(checkForErrors, tcConfig, tcImports, tcGlobals, None, TcResultsSink.WithSink sink, tcState, parsedMainInput) - |> Eventually.repeatedlyProgressUntilDoneOrTimeShareOverOrCanceled maxTimeShareMilliseconds ct (fun ctok f -> f ctok) - |> Eventually.forceAsync - (fun work -> - reactorOps.EnqueueAndAwaitOpAsync(userOpName, "CheckOneFile.Fragment", mainInputFileName, - fun ctok -> - // This work is not cancellable - let res = - // Reinstall the compilation globals each time we start or restart - use unwind = new CompilationGlobalsScope (errHandler.ErrorLogger, BuildPhase.TypeCheck) - work ctok - cancellable.Return(res) - )) + |> Eventually.toCancellable return result with e -> errorR e let mty = Construct.NewEmptyModuleOrNamespaceType ModuleOrNamespaceKind.Namespace - return Some((tcState.TcEnvFromSignatures, EmptyTopAttrs, [], [ mty ]), tcState) - } + return ((tcState.TcEnvFromSignatures, EmptyTopAttrs, [], [ mty ]), tcState) + } let errors = errHandler.CollectedDiagnostics let res = match resOpt with - | Some ((tcEnvAtEnd, _, implFiles, ccuSigsForFiles), tcState) -> + | ((tcEnvAtEnd, _, implFiles, ccuSigsForFiles), tcState) -> TypeCheckInfo(tcConfig, tcGlobals, List.head ccuSigsForFiles, tcState.Ccu, @@ -1823,12 +1802,8 @@ module internal ParseAndCheckFile = loadClosure, List.tryHead implFiles, sink.GetOpenDeclarations()) - |> Result.Ok - | None -> - Result.Error() return errors, res - } - + } [] type FSharpProjectContext(thisCcu: CcuThunk, assemblies: FSharpAssembly list, ad: AccessorDomain, projectOptions: FSharpProjectOptions) = @@ -2071,8 +2046,6 @@ type FSharpCheckFileResults moduleNamesDict: ModuleNamesDict, loadClosure: LoadClosure option, backgroundDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity)[], - reactorOps: IReactorOperations, - userOpName: string, isIncompleteTypeCheckEnvironment: bool, projectOptions: FSharpProjectOptions, builder: IncrementalBuilder, @@ -2081,27 +2054,17 @@ type FSharpCheckFileResults parseErrors: FSharpDiagnostic[], keepAssemblyContents: bool, suggestNamesForErrors: bool) = - async { + cancellable { let! tcErrors, tcFileInfo = ParseAndCheckFile.CheckOneFile (parseResults, sourceText, mainInputFileName, projectOptions, projectFileName, tcConfig, tcGlobals, tcImports, - tcState, moduleNamesDict, loadClosure, backgroundDiagnostics, reactorOps, - userOpName, suggestNamesForErrors) - match tcFileInfo with - | Result.Error () -> - return FSharpCheckFileAnswer.Aborted - | Result.Ok tcFileInfo -> - let errors = FSharpCheckFileResults.JoinErrors(isIncompleteTypeCheckEnvironment, creationErrors, parseErrors, tcErrors) - let results = FSharpCheckFileResults (mainInputFileName, errors, Some tcFileInfo, dependencyFiles, Some builder, keepAssemblyContents) - return FSharpCheckFileAnswer.Succeeded(results) + tcState, moduleNamesDict, loadClosure, backgroundDiagnostics, suggestNamesForErrors) + let errors = FSharpCheckFileResults.JoinErrors(isIncompleteTypeCheckEnvironment, creationErrors, parseErrors, tcErrors) + let results = FSharpCheckFileResults (mainInputFileName, errors, Some tcFileInfo, dependencyFiles, Some builder, keepAssemblyContents) + return results } -and [] FSharpCheckFileAnswer = - | Aborted - | Succeeded of FSharpCheckFileResults - - [] // 'details' is an option because the creation of the tcGlobals etc. for the project may have failed. type FSharpCheckProjectResults @@ -2216,7 +2179,6 @@ type FSharpCheckProjectResults override _.ToString() = "FSharpCheckProjectResults(" + projectFileName + ")" type FsiInteractiveChecker(legacyReferenceResolver, - reactorOps: IReactorOperations, tcConfig: TcConfig, tcGlobals: TcGlobals, tcImports: TcImports, @@ -2225,7 +2187,7 @@ type FsiInteractiveChecker(legacyReferenceResolver, let keepAssemblyContents = false member _.ParseAndCheckInteraction (ctok, sourceText: ISourceText, ?userOpName: string) = - async { + cancellable { let userOpName = defaultArg userOpName "Unknown" let filename = Path.Combine(tcConfig.implicitIncludeDir, "stdin.fsx") let suggestNamesForErrors = true // Will always be true, this is just for readability @@ -2273,24 +2235,26 @@ type FsiInteractiveChecker(legacyReferenceResolver, (parseResults, sourceText, filename, projectOptions, projectOptions.ProjectFileName, tcConfig, tcGlobals, tcImports, tcState, Map.empty, Some loadClosure, backgroundDiagnostics, - reactorOps, userOpName, suggestNamesForErrors) - - return - match tcFileInfo with - | Result.Ok tcFileInfo -> - let errors = Array.append parseErrors tcErrors - let typeCheckResults = FSharpCheckFileResults (filename, errors, Some tcFileInfo, dependencyFiles, None, false) - let projectResults = - FSharpCheckProjectResults (filename, Some tcConfig, - keepAssemblyContents, errors, - Some(tcGlobals, tcImports, tcFileInfo.ThisCcu, tcFileInfo.CcuSigForFile, - [tcFileInfo.ScopeSymbolUses], None, None, mkSimpleAssemblyRef "stdin", - tcState.TcEnvFromImpls.AccessRights, None, dependencyFiles, - projectOptions)) - - parseResults, typeCheckResults, projectResults - - | Result.Error () -> - failwith "unexpected aborted" + suggestNamesForErrors) + + let errors = Array.append parseErrors tcErrors + let typeCheckResults = FSharpCheckFileResults (filename, errors, Some tcFileInfo, dependencyFiles, None, false) + let projectResults = + FSharpCheckProjectResults (filename, Some tcConfig, + keepAssemblyContents, errors, + Some(tcGlobals, tcImports, tcFileInfo.ThisCcu, tcFileInfo.CcuSigForFile, + [tcFileInfo.ScopeSymbolUses], None, None, mkSimpleAssemblyRef "stdin", + tcState.TcEnvFromImpls.AccessRights, None, dependencyFiles, + projectOptions)) + + return parseResults, typeCheckResults, projectResults } +/// The result of calling TypeCheckResult including the possibility of abort and background compiler not caught up. +type [] public FSharpCheckFileAnswer = + /// Aborted because cancellation caused an abandonment of the operation + | Aborted + + /// Success + | Succeeded of FSharpCheckFileResults + diff --git a/src/fsharp/service/FSharpCheckerResults.fsi b/src/fsharp/service/FSharpCheckerResults.fsi index 0f519ca7572..93ab0cfcf05 100644 --- a/src/fsharp/service/FSharpCheckerResults.fsi +++ b/src/fsharp/service/FSharpCheckerResults.fsi @@ -348,8 +348,6 @@ type public FSharpCheckFileResults = moduleNamesDict: ModuleNamesDict * loadClosure: LoadClosure option * backgroundDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity)[] * - reactorOps: IReactorOperations * - userOpName: string * isIncompleteTypeCheckEnvironment: bool * projectOptions: FSharpProjectOptions * builder: IncrementalBuilder * @@ -358,7 +356,7 @@ type public FSharpCheckFileResults = parseErrors:FSharpDiagnostic[] * keepAssemblyContents: bool * suggestNamesForErrors: bool - -> Async + -> Cancellable /// The result of calling TypeCheckResult including the possibility of abort and background compiler not caught up. and [] public FSharpCheckFileAnswer = @@ -446,7 +444,6 @@ module internal ParseAndCheckFile = type internal FsiInteractiveChecker = internal new: LegacyReferenceResolver * - reactorOps: IReactorOperations * tcConfig: TcConfig * tcGlobals: TcGlobals * tcImports: TcImports * @@ -457,9 +454,8 @@ type internal FsiInteractiveChecker = ctok: CompilationThreadToken * sourceText:ISourceText * ?userOpName: string - -> Async + -> Cancellable module internal FSharpCheckerResultsSettings = val defaultFSharpBinariesDir: string - val maxTimeShareMilliseconds : int64 diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index ea9573d82f7..3dadec23f0b 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -212,7 +212,7 @@ type BoundModel private (tcConfig: TcConfig, tcGlobals: TcGlobals, tcImports: TcImports, keepAssemblyContents, keepAllBackgroundResolutions, - maxTimeShareMilliseconds, keepAllBackgroundSymbolUses, + keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking, beforeFileChecked: Event, @@ -269,26 +269,26 @@ type BoundModel private (tcConfig: TcConfig, ) member this.GetState(partialCheck: bool) = - let partialCheck = - // Only partial check if we have enabled it. - if enablePartialTypeChecking then partialCheck - else false + eventually { + let partialCheck = + // Only partial check if we have enabled it. + if enablePartialTypeChecking then partialCheck + else false - let mustCheck = - match lazyTcInfoState, partialCheck with - | None, _ -> true - | Some(PartialState _), false -> true - | _ -> false + let mustCheck = + match lazyTcInfoState, partialCheck with + | None, _ -> true + | Some(PartialState _), false -> true + | _ -> false - match lazyTcInfoState with - | Some tcInfoState when not mustCheck -> tcInfoState |> Eventually.Done - | _ -> - lazyTcInfoState <- None - eventually { + match lazyTcInfoState with + | Some tcInfoState when not mustCheck -> return tcInfoState + | _ -> + lazyTcInfoState <- None let! tcInfoState = this.TypeCheck(partialCheck) lazyTcInfoState <- Some tcInfoState return tcInfoState - } + } member this.TryOptionalExtras() = eventually { @@ -308,7 +308,6 @@ type BoundModel private (tcConfig: TcConfig, tcImports, keepAssemblyContents, keepAllBackgroundResolutions, - maxTimeShareMilliseconds, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking, @@ -337,7 +336,6 @@ type BoundModel private (tcConfig: TcConfig, tcImports, keepAssemblyContents, keepAllBackgroundResolutions, - maxTimeShareMilliseconds, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking, @@ -349,7 +347,7 @@ type BoundModel private (tcConfig: TcConfig, Some finishState) } - member this.TcInfo = + member this.GetTcInfo() = eventually { let! state = this.GetState(true) return state.TcInfo @@ -363,7 +361,7 @@ type BoundModel private (tcConfig: TcConfig, | PartialState(tcInfo) -> Some tcInfo | _ -> None - member this.TcInfoWithExtras = + member this.GetTcInfoWithExtras() = eventually { let! state = this.GetState(false) match state with @@ -399,124 +397,112 @@ type BoundModel private (tcConfig: TcConfig, None match syntaxTree.Parse sigNameOpt with | input, _sourceRange, filename, parseErrors -> + IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBETypechecked filename) let capturingErrorLogger = CompilationErrorLogger("TypeCheck", tcConfig.errorSeverityOptions) let errorLogger = GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput input, capturingErrorLogger) - let fullComputation = - eventually { - beforeFileChecked.Trigger filename - let prevModuleNamesDict = prevTcInfo.moduleNamesDict - let prevTcState = prevTcInfo.tcState - let prevTcErrorsRev = prevTcInfo.tcErrorsRev - let prevTcDependencyFiles = prevTcInfo.tcDependencyFiles - - ApplyMetaCommandsFromInputToTcConfig (tcConfig, input, Path.GetDirectoryName filename, tcImports.DependencyProvider) |> ignore - let sink = TcResultsSinkImpl(tcGlobals) - let hadParseErrors = not (Array.isEmpty parseErrors) - let input, moduleNamesDict = DeduplicateParsedInputModuleName prevModuleNamesDict input - - Logger.LogBlockMessageStart filename LogCompilerFunctionId.IncrementalBuild_TypeCheck - let! (tcEnvAtEndOfFile, topAttribs, implFile, ccuSigForFile), tcState = - TypeCheckOneInputEventually - ((fun () -> hadParseErrors || errorLogger.ErrorCount > 0), - tcConfig, tcImports, - tcGlobals, - None, - (if partialCheck then TcResultsSink.NoSink else TcResultsSink.WithSink sink), - prevTcState, input, - partialCheck) - Logger.LogBlockMessageStop filename LogCompilerFunctionId.IncrementalBuild_TypeCheck - - fileChecked.Trigger filename - let newErrors = Array.append parseErrors (capturingErrorLogger.GetDiagnostics()) - - let tcEnvAtEndOfFile = if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls - - let tcInfo = - { - tcState = tcState - tcEnvAtEndOfFile = tcEnvAtEndOfFile - moduleNamesDict = moduleNamesDict - latestCcuSigForFile = Some ccuSigForFile - tcErrorsRev = newErrors :: prevTcErrorsRev - topAttribs = Some topAttribs - tcDependencyFiles = filename :: prevTcDependencyFiles - sigNameOpt = - match input with - | ParsedInput.SigFile(ParsedSigFileInput(fileName=fileName;qualifiedNameOfFile=qualName)) -> - Some(fileName, qualName) - | _ -> - None - } - - if partialCheck then - return PartialState tcInfo - else - match! prevTcInfoExtras() with - | None -> return PartialState tcInfo - | Some prevTcInfoOptional -> - // Build symbol keys - let itemKeyStore, semanticClassification = - if enableBackgroundItemKeyStoreAndSemanticClassification then - Logger.LogBlockMessageStart filename LogCompilerFunctionId.IncrementalBuild_CreateItemKeyStoreAndSemanticClassification - let sResolutions = sink.GetResolutions() - let builder = ItemKeyStoreBuilder() - let preventDuplicates = HashSet({ new IEqualityComparer with - member _.Equals((s1, e1): struct(pos * pos), (s2, e2): struct(pos * pos)) = Position.posEq s1 s2 && Position.posEq e1 e2 - member _.GetHashCode o = o.GetHashCode() }) - sResolutions.CapturedNameResolutions - |> Seq.iter (fun cnr -> - let r = cnr.Range - if preventDuplicates.Add struct(r.Start, r.End) then - builder.Write(cnr.Range, cnr.Item)) + + // This reinstalls the CompilationGlobalsScope each time the Eventually is restarted, potentially + // on a new thread. This is needed because CompilationGlobalsScope installs thread local variables. + return! Eventually.reusing (fun () -> new CompilationGlobalsScope (errorLogger, BuildPhase.TypeCheck) :> IDisposable) <| eventually { + + beforeFileChecked.Trigger filename + let prevModuleNamesDict = prevTcInfo.moduleNamesDict + let prevTcState = prevTcInfo.tcState + let prevTcErrorsRev = prevTcInfo.tcErrorsRev + let prevTcDependencyFiles = prevTcInfo.tcDependencyFiles + + ApplyMetaCommandsFromInputToTcConfig (tcConfig, input, Path.GetDirectoryName filename, tcImports.DependencyProvider) |> ignore + let sink = TcResultsSinkImpl(tcGlobals) + let hadParseErrors = not (Array.isEmpty parseErrors) + let input, moduleNamesDict = DeduplicateParsedInputModuleName prevModuleNamesDict input + + Logger.LogBlockMessageStart filename LogCompilerFunctionId.IncrementalBuild_TypeCheck + let! (tcEnvAtEndOfFile, topAttribs, implFile, ccuSigForFile), tcState = + TypeCheckOneInputEventually + ((fun () -> hadParseErrors || errorLogger.ErrorCount > 0), + tcConfig, tcImports, + tcGlobals, + None, + (if partialCheck then TcResultsSink.NoSink else TcResultsSink.WithSink sink), + prevTcState, input, + partialCheck) + Logger.LogBlockMessageStop filename LogCompilerFunctionId.IncrementalBuild_TypeCheck + + fileChecked.Trigger filename + let newErrors = Array.append parseErrors (capturingErrorLogger.GetDiagnostics()) + + let tcEnvAtEndOfFile = if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls + + let tcInfo = + { + tcState = tcState + tcEnvAtEndOfFile = tcEnvAtEndOfFile + moduleNamesDict = moduleNamesDict + latestCcuSigForFile = Some ccuSigForFile + tcErrorsRev = newErrors :: prevTcErrorsRev + topAttribs = Some topAttribs + tcDependencyFiles = filename :: prevTcDependencyFiles + sigNameOpt = + match input with + | ParsedInput.SigFile(ParsedSigFileInput(fileName=fileName;qualifiedNameOfFile=qualName)) -> + Some(fileName, qualName) + | _ -> + None + } + + if partialCheck then + return PartialState tcInfo + else + match! prevTcInfoExtras() with + | None -> return PartialState tcInfo + | Some prevTcInfoOptional -> + // Build symbol keys + let itemKeyStore, semanticClassification = + if enableBackgroundItemKeyStoreAndSemanticClassification then + Logger.LogBlockMessageStart filename LogCompilerFunctionId.IncrementalBuild_CreateItemKeyStoreAndSemanticClassification + let sResolutions = sink.GetResolutions() + let builder = ItemKeyStoreBuilder() + let preventDuplicates = HashSet({ new IEqualityComparer with + member _.Equals((s1, e1): struct(pos * pos), (s2, e2): struct(pos * pos)) = Position.posEq s1 s2 && Position.posEq e1 e2 + member _.GetHashCode o = o.GetHashCode() }) + sResolutions.CapturedNameResolutions + |> Seq.iter (fun cnr -> + let r = cnr.Range + if preventDuplicates.Add struct(r.Start, r.End) then + builder.Write(cnr.Range, cnr.Item)) - let semanticClassification = sResolutions.GetSemanticClassification(tcGlobals, tcImports.GetImportMap(), sink.GetFormatSpecifierLocations(), None) - - let sckBuilder = SemanticClassificationKeyStoreBuilder() - sckBuilder.WriteAll semanticClassification - - let res = builder.TryBuildAndReset(), sckBuilder.TryBuildAndReset() - Logger.LogBlockMessageStop filename LogCompilerFunctionId.IncrementalBuild_CreateItemKeyStoreAndSemanticClassification - res - else - None, None - - let tcInfoExtras = - { - /// Only keep the typed interface files when doing a "full" build for fsc.exe, otherwise just throw them away - latestImplFile = if keepAssemblyContents then implFile else None - tcResolutionsRev = (if keepAllBackgroundResolutions then sink.GetResolutions() else TcResolutions.Empty) :: prevTcInfoOptional.tcResolutionsRev - tcSymbolUsesRev = (if keepAllBackgroundSymbolUses then sink.GetSymbolUses() else TcSymbolUses.Empty) :: prevTcInfoOptional.tcSymbolUsesRev - tcOpenDeclarationsRev = sink.GetOpenDeclarations() :: prevTcInfoOptional.tcOpenDeclarationsRev - itemKeyStore = itemKeyStore - semanticClassificationKeyStore = semanticClassification - } - - return FullState(tcInfo, tcInfoExtras) - - } - - // Run part of the Eventually<_> computation until a timeout is reached. If not complete, - // return a new Eventually<_> computation which recursively runs more of the computation. - // - When the whole thing is finished commit the error results sent through the errorLogger. - // - Each time we do real work we reinstall the CompilationGlobalsScope - let timeSlicedComputation = - fullComputation |> - Eventually.repeatedlyProgressUntilDoneOrTimeShareOverOrCanceled - maxTimeShareMilliseconds - CancellationToken.None - (fun ctok f -> - // Reinstall the compilation globals each time we start or restart - use unwind = new CompilationGlobalsScope (errorLogger, BuildPhase.TypeCheck) - f ctok) - return! timeSlicedComputation - } + let semanticClassification = sResolutions.GetSemanticClassification(tcGlobals, tcImports.GetImportMap(), sink.GetFormatSpecifierLocations(), None) + + let sckBuilder = SemanticClassificationKeyStoreBuilder() + sckBuilder.WriteAll semanticClassification + + let res = builder.TryBuildAndReset(), sckBuilder.TryBuildAndReset() + Logger.LogBlockMessageStop filename LogCompilerFunctionId.IncrementalBuild_CreateItemKeyStoreAndSemanticClassification + res + else + None, None + + let tcInfoExtras = + { + /// Only keep the typed interface files when doing a "full" build for fsc.exe, otherwise just throw them away + latestImplFile = if keepAssemblyContents then implFile else None + tcResolutionsRev = (if keepAllBackgroundResolutions then sink.GetResolutions() else TcResolutions.Empty) :: prevTcInfoOptional.tcResolutionsRev + tcSymbolUsesRev = (if keepAllBackgroundSymbolUses then sink.GetSymbolUses() else TcSymbolUses.Empty) :: prevTcInfoOptional.tcSymbolUsesRev + tcOpenDeclarationsRev = sink.GetOpenDeclarations() :: prevTcInfoOptional.tcOpenDeclarationsRev + itemKeyStore = itemKeyStore + semanticClassificationKeyStore = semanticClassification + } + + return FullState(tcInfo, tcInfoExtras) + } + } static member Create(tcConfig: TcConfig, tcGlobals: TcGlobals, tcImports: TcImports, keepAssemblyContents, keepAllBackgroundResolutions, - maxTimeShareMilliseconds, keepAllBackgroundSymbolUses, + keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking, beforeFileChecked: Event, @@ -526,7 +512,7 @@ type BoundModel private (tcConfig: TcConfig, syntaxTreeOpt: SyntaxTree option) = BoundModel(tcConfig, tcGlobals, tcImports, keepAssemblyContents, keepAllBackgroundResolutions, - maxTimeShareMilliseconds, keepAllBackgroundSymbolUses, + keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking, beforeFileChecked, @@ -589,11 +575,6 @@ type FrameworkImportsCache(size) = [] type PartialCheckResults (boundModel: BoundModel, timeStamp: DateTime) = - let eval ctok (work: Eventually<'T>) = - match work with - | Eventually.Done res -> res - | _ -> Eventually.force ctok work - member _.TcImports = boundModel.TcImports member _.TcGlobals = boundModel.TcGlobals @@ -604,17 +585,21 @@ type PartialCheckResults (boundModel: BoundModel, timeStamp: DateTime) = member _.TryTcInfo = boundModel.TryTcInfo - member _.GetTcInfo ctok = boundModel.TcInfo |> eval ctok + member _.GetTcInfo() = boundModel.GetTcInfo() - member _.GetTcInfoWithExtras ctok = boundModel.TcInfoWithExtras |> eval ctok + member _.GetTcInfoWithExtras() = boundModel.GetTcInfoWithExtras() - member _.TryGetItemKeyStore ctok = - let _, info = boundModel.TcInfoWithExtras |> eval ctok - info.itemKeyStore + member _.TryGetItemKeyStore() = + eventually { + let! _, info = boundModel.GetTcInfoWithExtras() + return info.itemKeyStore + } - member _.GetSemanticClassification ctok = - let _, info = boundModel.TcInfoWithExtras |> eval ctok - info.semanticClassificationKeyStore + member _.GetSemanticClassification() = + eventually { + let! _, info = boundModel.GetTcInfoWithExtras() + return info.semanticClassificationKeyStore + } [] module Utilities = @@ -685,7 +670,6 @@ type IncrementalBuilder(tcGlobals, loadClosureOpt: LoadClosure option, keepAssemblyContents, keepAllBackgroundResolutions, - maxTimeShareMilliseconds, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking, @@ -825,7 +809,6 @@ type IncrementalBuilder(tcGlobals, tcImports, keepAssemblyContents, keepAllBackgroundResolutions, - maxTimeShareMilliseconds, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, defaultPartialTypeChecking, @@ -848,31 +831,35 @@ type IncrementalBuilder(tcGlobals, /// Finish up the typechecking to produce outputs for the rest of the compilation process let FinalizeTypeCheckTask ctok enablePartialTypeChecking (boundModels: ImmutableArray) = - cancellable { + eventually { DoesNotRequireCompilerThreadTokenAndCouldPossiblyBeMadeConcurrent ctok let errorLogger = CompilationErrorLogger("CombineImportedAssembliesTask", tcConfig.errorSeverityOptions) - use _holder = new CompilationGlobalsScope(errorLogger, BuildPhase.TypeCheck) + // This reinstalls the CompilationGlobalsScope each time the Eventually is restarted, potentially + // on a new thread. This is needed because CompilationGlobalsScope installs thread local variables. + return! Eventually.reusing (fun () -> new CompilationGlobalsScope (errorLogger, BuildPhase.TypeCheck) :> IDisposable) <| eventually { + + let! results = + boundModels |> Eventually.each (fun boundModel -> eventually { + let! tcInfo, latestImplFile = + eventually { + if enablePartialTypeChecking then + let! tcInfo = boundModel.GetTcInfo() + return tcInfo, None + else + let! tcInfo, tcInfoExtras = boundModel.GetTcInfoWithExtras() + return tcInfo, tcInfoExtras.latestImplFile + } + return (tcInfo.tcEnvAtEndOfFile, defaultArg tcInfo.topAttribs EmptyTopAttrs, latestImplFile, tcInfo.latestCcuSigForFile) + }) // Get the state at the end of the type-checking of the last file let finalBoundModel = boundModels.[boundModels.Length-1] - let finalInfo = finalBoundModel.TcInfo |> Eventually.force ctok + let! finalInfo = finalBoundModel.GetTcInfo() // Finish the checking let (_tcEnvAtEndOfLastFile, topAttrs, mimpls, _), tcState = - let results = - boundModels - |> List.ofSeq - |> List.map (fun boundModel -> - let tcInfo, latestImplFile = - if enablePartialTypeChecking then - let tcInfo = boundModel.TcInfo |> Eventually.force ctok - tcInfo, None - else - let tcInfo, tcInfoExtras = boundModel.TcInfoWithExtras |> Eventually.force ctok - tcInfo, tcInfoExtras.latestImplFile - tcInfo.tcEnvAtEndOfFile, defaultArg tcInfo.topAttribs EmptyTopAttrs, latestImplFile, tcInfo.latestCcuSigForFile) TypeCheckMultipleInputsFinish (results, finalInfo.tcState) let ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt = @@ -930,9 +917,11 @@ type IncrementalBuilder(tcGlobals, errorRecoveryNoRange e mkSimpleAssemblyRef assemblyName, None, None - let finalBoundModelWithErrors = finalBoundModel.Finish((errorLogger.GetDiagnostics() :: finalInfo.tcErrorsRev), Some topAttrs) |> Eventually.force ctok + let diagnostics = errorLogger.GetDiagnostics() :: finalInfo.tcErrorsRev + let! finalBoundModelWithErrors = finalBoundModel.Finish(diagnostics, Some topAttrs) return ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt, finalBoundModelWithErrors } + } // END OF BUILD TASK FUNCTIONS // --------------------------------------------------------------------------------------------- @@ -1017,69 +1006,57 @@ type IncrementalBuilder(tcGlobals, boundModels = Array.init count (fun _ -> None) |> ImmutableArray.CreateRange } else - { state with - stampedReferencedAssemblies = stampedReferencedAssemblies.ToImmutable() - } + state let computeInitialBoundModel (state: IncrementalBuilderState) (ctok: CompilationThreadToken) = - cancellable { + eventually { match state.initialBoundModel with | None -> - let! result = CombineImportedAssembliesTask ctok + // Note this is not time-sliced + let! result = CombineImportedAssembliesTask ctok |> Eventually.ofCancellable return { state with initialBoundModel = Some result }, result | Some result -> return state, result } let computeBoundModel state (cache: TimeStampCache) (ctok: CompilationThreadToken) (slot: int) = - if IncrementalBuild.injectCancellationFault then Cancellable.canceled () - else - - cancellable { - let! (state, initial) = computeInitialBoundModel state ctok + if IncrementalBuild.injectCancellationFault then Eventually.canceled() else + eventually { let fileInfo = fileNames.[slot] let state = computeStampedFileName state cache slot fileInfo - let state = - if state.boundModels.[slot].IsNone then - let prevBoundModel = - match slot with - | 0 (* first file *) -> initial - | _ -> - match state.boundModels.[slot - 1] with - | Some(prevBoundModel) -> prevBoundModel - | _ -> - // This shouldn't happen, but on the off-chance, just grab the initial bound model. - initial - - let boundModel = TypeCheckTask ctok state.enablePartialTypeChecking prevBoundModel (ParseTask fileInfo) |> Eventually.force ctok + if state.boundModels.[slot].IsNone then + let! (state, initial) = computeInitialBoundModel state ctok + + let prevBoundModel = + match slot with + | 0 (* first file *) -> initial + | _ -> + match state.boundModels.[slot - 1] with + | Some(prevBoundModel) -> prevBoundModel + | _ -> + // This shouldn't happen, but on the off-chance, just grab the initial bound model. + initial + + let! boundModel = TypeCheckTask ctok state.enablePartialTypeChecking prevBoundModel (ParseTask fileInfo) + let state = { state with boundModels = state.boundModels.SetItem(slot, Some boundModel) } - else - state + return state - return state + else + return state } let computeBoundModels state (cache: TimeStampCache) (ctok: CompilationThreadToken) = - let mutable state = state - let task = - cancellable { - for slot = 0 to fileNames.Length - 1 do - let! newState = computeBoundModel state cache ctok slot - state <- newState - } - cancellable { - let! _ = task - return state - } + (state, [0..fileNames.Length-1]) ||> Eventually.fold (fun state slot -> computeBoundModel state cache ctok slot) let computeFinalizedBoundModel state (cache: TimeStampCache) (ctok: CompilationThreadToken) = - cancellable { + eventually { let! state = computeBoundModels state cache ctok match state.finalizedBoundModel with @@ -1087,24 +1064,11 @@ type IncrementalBuilder(tcGlobals, | _ -> let boundModels = state.boundModels |> Seq.choose id |> ImmutableArray.CreateRange - let! result = FinalizeTypeCheckTask ctok state.enablePartialTypeChecking boundModels + let! result = FinalizeTypeCheckTask ctok state.enablePartialTypeChecking boundModels let result = (result, DateTime.UtcNow) return { state with finalizedBoundModel = Some result }, result } - let step state (cache: TimeStampCache) (ctok: CompilationThreadToken) = - cancellable { - let state = computeStampedReferencedAssemblies state cache - let state = computeStampedFileNames state cache - - match state.boundModels |> Seq.tryFindIndex (fun x -> x.IsNone) with - | Some slot -> - let! state = computeBoundModel state cache ctok slot - return state, true - | _ -> - return state, false - } - let tryGetBeforeSlot (state: IncrementalBuilderState) slot = match slot with | 0 (* first file *) -> @@ -1122,27 +1086,14 @@ type IncrementalBuilder(tcGlobals, | _ -> None - let eval state (cache: TimeStampCache) ctok targetSlot = - if targetSlot < 0 then - cancellable { - let state = computeStampedReferencedAssemblies state cache - - let! state, result = computeInitialBoundModel state ctok + let evalUpToTargetSlot state (cache: TimeStampCache) ctok targetSlot = + cancellable { + let state = computeStampedReferencedAssemblies state cache + if targetSlot < 0 then + let! state, result = computeInitialBoundModel state ctok |> Eventually.toCancellable return state, Some(result, DateTime.MinValue) - } - else - let mutable state = state - let evalUpTo = - cancellable { - for slot = 0 to targetSlot do - let! newState = computeBoundModel state cache ctok slot - state <- newState - } - cancellable { - let newState = computeStampedReferencedAssemblies state cache - state <- newState - - let! _ = evalUpTo + else + let! state = (state, [0..targetSlot]) ||> Eventually.fold (fun state slot -> computeBoundModel state cache ctok slot) |> Eventually.toCancellable let result = state.boundModels.[targetSlot] @@ -1151,13 +1102,13 @@ type IncrementalBuilder(tcGlobals, ) return state, result - } + } let tryGetFinalized state cache ctok = cancellable { let state = computeStampedReferencedAssemblies state cache - let! state, res = computeFinalizedBoundModel state cache ctok + let! state, res = computeFinalizedBoundModel state cache ctok |> Eventually.toCancellable return state, Some res } @@ -1209,16 +1160,19 @@ type IncrementalBuilder(tcGlobals, member _.AllDependenciesDeprecated = allDependencies - member _.Step (ctok: CompilationThreadToken) = - cancellable { + member _.PopulatePartialCheckingResults (ctok: CompilationThreadToken) = + eventually { let cache = TimeStampCache defaultTimeStamp // One per step - let! state, res = step currentState cache ctok + let state = currentState + let state = computeStampedFileNames state cache setCurrentState ctok state - if not res then - projectChecked.Trigger() - return false - else - return true + do! Eventually.ret () // allow cancellation + let state = computeStampedReferencedAssemblies state cache + setCurrentState ctok state + do! Eventually.ret () // allow cancellation + let! state, _res = computeFinalizedBoundModel state cache ctok + setCurrentState ctok state + projectChecked.Trigger() } member builder.GetCheckResultsBeforeFileInProjectEvenIfStale filename: PartialCheckResults option = @@ -1250,7 +1204,7 @@ type IncrementalBuilder(tcGlobals, member private _.GetCheckResultsBeforeSlotInProject (ctok: CompilationThreadToken, slotOfFile, enablePartialTypeChecking) = cancellable { let cache = TimeStampCache defaultTimeStamp - let! state, result = eval { currentState with enablePartialTypeChecking = enablePartialTypeChecking } cache ctok (slotOfFile - 1) + let! state, result = evalUpToTargetSlot { currentState with enablePartialTypeChecking = enablePartialTypeChecking } cache ctok (slotOfFile - 1) setCurrentState ctok { state with enablePartialTypeChecking = defaultPartialTypeChecking } match result with | Some (boundModel, timestamp) -> return PartialCheckResults(boundModel, timestamp) @@ -1272,7 +1226,7 @@ type IncrementalBuilder(tcGlobals, cancellable { let slotOfFile = builder.GetSlotOfFileName filename + 1 let! result = builder.GetCheckResultsBeforeSlotInProject(ctok, slotOfFile, false) - result.GetTcInfoWithExtras ctok |> ignore // Make sure we forcefully evaluate the info + let! _ = result.GetTcInfoWithExtras() |> Eventually.toCancellable // Make sure we forcefully evaluate the info return result } @@ -1300,7 +1254,7 @@ type IncrementalBuilder(tcGlobals, cancellable { let! result = builder.GetCheckResultsAndImplementationsForProject(ctok, false) let results, _, _, _ = result - results.GetTcInfoWithExtras ctok |> ignore // Make sure we forcefully evaluate the info + let! _ = results.GetTcInfoWithExtras() |> Eventually.toCancellable // Make sure we forcefully evaluate the info return result } @@ -1352,7 +1306,7 @@ type IncrementalBuilder(tcGlobals, commandLineArgs: string list, projectReferences, projectDirectory, useScriptResolutionRules, keepAssemblyContents, - keepAllBackgroundResolutions, maxTimeShareMilliseconds, + keepAllBackgroundResolutions, tryGetMetadataSnapshot, suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, @@ -1501,7 +1455,6 @@ type IncrementalBuilder(tcGlobals, loadClosureOpt, keepAssemblyContents, keepAllBackgroundResolutions, - maxTimeShareMilliseconds, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking, diff --git a/src/fsharp/service/IncrementalBuild.fsi b/src/fsharp/service/IncrementalBuild.fsi index fd6774aa032..bcaa09b9422 100755 --- a/src/fsharp/service/IncrementalBuild.fsi +++ b/src/fsharp/service/IncrementalBuild.fsi @@ -3,6 +3,7 @@ namespace FSharp.Compiler.CodeAnalysis open System +open System.Threading open Internal.Utilities.Library open FSharp.Compiler open FSharp.Compiler.AbstractIL @@ -108,21 +109,21 @@ type internal PartialCheckResults = /// Compute the "TcInfo" part of the results. If `enablePartialTypeChecking` is false then /// extras will also be available. - member GetTcInfo: CompilationThreadToken -> TcInfo + member GetTcInfo: unit -> Eventually /// Compute both the "TcInfo" and "TcInfoExtras" parts of the results. /// Can cause a second type-check if `enablePartialTypeChecking` is true in the checker. /// Only use when it's absolutely necessary to get rich information on a file. - member GetTcInfoWithExtras: CompilationThreadToken -> TcInfo * TcInfoExtras + member GetTcInfoWithExtras: unit -> Eventually /// Compute the "ItemKeyStore" parts of the results. /// Can cause a second type-check if `enablePartialTypeChecking` is true in the checker. /// Only use when it's absolutely necessary to get rich information on a file. - member TryGetItemKeyStore: CompilationThreadToken -> ItemKeyStore option + member TryGetItemKeyStore: unit -> Eventually /// Can cause a second type-check if `enablePartialTypeChecking` is true in the checker. /// Only use when it's absolutely necessary to get rich information on a file. - member GetSemanticClassification: CompilationThreadToken -> SemanticClassificationKeyStore option + member GetSemanticClassification: unit -> Eventually member TimeStamp: DateTime @@ -159,8 +160,8 @@ type internal IncrementalBuilder = /// The list of files the build depends on member AllDependenciesDeprecated : string[] - /// Perform one step in the F# build. Return true if the background work is finished. - member Step : CompilationThreadToken -> Cancellable + /// The project build. Return true if the background work is finished. + member PopulatePartialCheckingResults: CompilationThreadToken -> Eventually /// Get the preceding typecheck state of a slot, without checking if it is up-to-date w.r.t. /// the timestamps on files and referenced DLLs prior to this one. Return None if the result is not available. @@ -245,7 +246,6 @@ type internal IncrementalBuilder = useScriptResolutionRules:bool * keepAssemblyContents: bool * keepAllBackgroundResolutions: bool * - maxTimeShareMilliseconds: int64 * tryGetMetadataSnapshot: ILBinaryReader.ILReaderTryGetMetadataSnapshot * suggestNamesForErrors: bool * keepAllBackgroundSymbolUses: bool * diff --git a/src/fsharp/service/Reactor.fs b/src/fsharp/service/Reactor.fs index 36a17d9bc84..5f5eebe711a 100755 --- a/src/fsharp/service/Reactor.fs +++ b/src/fsharp/service/Reactor.fs @@ -18,7 +18,7 @@ type internal IReactorOperations = [] type internal ReactorCommands = /// Kick off a build. - | SetBackgroundOp of ( (* userOpName: *) string * (* opName: *) string * (* opArg: *) string * (CompilationThreadToken -> CancellationToken -> bool)) option + | SetBackgroundOp of ( (* userOpName: *) string * (* opName: *) string * (* opArg: *) string * (CompilationThreadToken -> Eventually)) option /// Do some work not synchronized in the mailbox. | Op of userOpName: string * opName: string * opArg: string * CancellationToken * (CompilationThreadToken -> unit) * (unit -> unit) @@ -43,6 +43,16 @@ type Reactor() = let mutable bgOpCts = new CancellationTokenSource() + let sw = new System.Diagnostics.Stopwatch() + + /// Maximum time share for a piece of background work before it should (cooperatively) yield + /// to enable other requests to be serviced. Yielding means returning a continuation function + /// (via an Eventually<_> value of case NotYetDone) that can be called as the next piece of work. + let maxTimeShareMilliseconds = + match System.Environment.GetEnvironmentVariable("FCS_MaxTimeShare") with + | null | "" -> 100L + | s -> int64 s + /// Mailbox dispatch function. let builder = MailboxProcessor<_>.Start <| fun inbox -> @@ -72,6 +82,15 @@ type Reactor() = Thread.CurrentThread.CurrentUICulture <- culture match msg with | Some (SetBackgroundOp bgOpOpt) -> + let bgOpOpt = + match bgOpOpt with + | None -> None + | Some (bgUserOpName, bgOpName, bgOpArg, bgOp) -> + let oldBgOpCts = bgOpCts + bgOpCts <- new CancellationTokenSource() + oldBgOpCts.Dispose() + Some (bgUserOpName, bgOpName, bgOpArg, bgOp ctok) + //Trace.TraceInformation("Reactor: --> set background op, remaining {0}", inbox.CurrentQueueLength) return! loop (bgOpOpt, onComplete, false) @@ -88,15 +107,19 @@ type Reactor() = let msg = (if taken > 10000.0 then "BAD-OP: >10s " elif taken > 3000.0 then "BAD-OP: >3s " elif taken > 1000.0 then "BAD-OP: > 1s " elif taken > 500.0 then "BAD-OP: >0.5s " else "") Trace.TraceInformation("Reactor: {0:n3} {1}<-- {2}.{3}, took {4} ms", DateTime.Now.TimeOfDay.TotalSeconds, msg, userOpName, opName, span.TotalMilliseconds) return! loop (bgOpOpt, onComplete, false) + | Some (WaitForBackgroundOpCompletion channel) -> match bgOpOpt with | None -> () | Some (bgUserOpName, bgOpName, bgOpArg, bgOp) -> Trace.TraceInformation("Reactor: {0:n3} --> wait for background {1}.{2} ({3}), remaining {4}", DateTime.Now.TimeOfDay.TotalSeconds, bgUserOpName, bgOpName, bgOpArg, inbox.CurrentQueueLength) - bgOpCts.Dispose() + let oldBgOpCts = bgOpCts bgOpCts <- new CancellationTokenSource() - while not bgOpCts.IsCancellationRequested && bgOp ctok bgOpCts.Token do - () + oldBgOpCts.Dispose() + + try + Eventually.force bgOpCts.Token bgOp |> ignore + with :? OperationCanceledException -> () if bgOpCts.IsCancellationRequested then Trace.TraceInformation("FCS: <-- wait for background was cancelled {0}.{1}", bgUserOpName, bgOpName) @@ -111,21 +134,27 @@ type Reactor() = | None -> match bgOpOpt, onComplete with | _, Some onComplete -> onComplete.Reply() - | Some (bgUserOpName, bgOpName, bgOpArg, bgOp), None -> + | Some (bgUserOpName, bgOpName, bgOpArg, bgEv), None -> Trace.TraceInformation("Reactor: {0:n3} --> background step {1}.{2} ({3})", DateTime.Now.TimeOfDay.TotalSeconds, bgUserOpName, bgOpName, bgOpArg) - let time = Stopwatch() - time.Start() - bgOpCts.Dispose() - bgOpCts <- new CancellationTokenSource() - let res = bgOp ctok bgOpCts.Token - if bgOpCts.IsCancellationRequested then - Trace.TraceInformation("FCS: <-- background step {0}.{1}, was cancelled", bgUserOpName, bgOpName) - time.Stop() - let taken = time.Elapsed.TotalMilliseconds + + // Force for a timeslice. If cancellation occurs we abandon the background work. + let bgOpRes = + match Eventually.forceForTimeSlice sw maxTimeShareMilliseconds bgOpCts.Token bgEv with + | ValueOrCancelled.Value cont -> cont + | ValueOrCancelled.Cancelled _ -> Eventually.Done () + + let bgOp2 = + match bgOpRes with + | _ when bgOpCts.IsCancellationRequested -> + Trace.TraceInformation("FCS: <-- background step {0}.{1}, was cancelled", bgUserOpName, bgOpName) + None + | Eventually.Done () -> None + | bgEv2 -> Some (bgUserOpName, bgOpName, bgOpArg, bgEv2) + //if span.TotalMilliseconds > 100.0 then - let msg = (if taken > 10000.0 then "BAD-BG-SLICE: >10s " elif taken > 3000.0 then "BAD-BG-SLICE: >3s " elif taken > 1000.0 then "BAD-BG-SLICE: > 1s " else "") - Trace.TraceInformation("Reactor: {0:n3} {1}<-- background step, took {2}ms", DateTime.Now.TimeOfDay.TotalSeconds, msg, taken) - return! loop ((if res then bgOpOpt else None), onComplete, true) + //let msg = (if taken > 10000.0 then "BAD-BG-SLICE: >10s " elif taken > 3000.0 then "BAD-BG-SLICE: >3s " elif taken > 1000.0 then "BAD-BG-SLICE: > 1s " else "") + //Trace.TraceInformation("Reactor: {0:n3} {1}<-- background step, took {2}ms", DateTime.Now.TimeOfDay.TotalSeconds, msg, taken) + return! loop (bgOp2, onComplete, true) | None, None -> failwith "unreachable, should have used inbox.Receive" } async { @@ -148,34 +177,34 @@ type Reactor() = | None -> () // [Foreground Mailbox Accessors] ----------------------------------------------------------- - member r.SetBackgroundOp(bgOpOpt) = + member _.SetBackgroundOp(bgOpOpt) = Trace.TraceInformation("Reactor: {0:n3} enqueue start background, length {1}", DateTime.Now.TimeOfDay.TotalSeconds, builder.CurrentQueueLength) bgOpCts.Cancel() builder.Post(SetBackgroundOp bgOpOpt) - member r.CancelBackgroundOp() = + member _.CancelBackgroundOp() = Trace.TraceInformation("FCS: trying to cancel any active background work") bgOpCts.Cancel() - member r.EnqueueOp(userOpName, opName, opArg, op) = + member _.EnqueueOp(userOpName, opName, opArg, op) = Trace.TraceInformation("Reactor: {0:n3} enqueue {1}.{2} ({3}), length {4}", DateTime.Now.TimeOfDay.TotalSeconds, userOpName, opName, opArg, builder.CurrentQueueLength) builder.Post(Op(userOpName, opName, opArg, CancellationToken.None, op, (fun () -> ()))) - member r.EnqueueOpPrim(userOpName, opName, opArg, ct, op, ccont) = + member _.EnqueueOpPrim(userOpName, opName, opArg, ct, op, ccont) = Trace.TraceInformation("Reactor: {0:n3} enqueue {1}.{2} ({3}), length {4}", DateTime.Now.TimeOfDay.TotalSeconds, userOpName, opName, opArg, builder.CurrentQueueLength) builder.Post(Op(userOpName, opName, opArg, ct, op, ccont)) - member r.CurrentQueueLength = + member _.CurrentQueueLength = builder.CurrentQueueLength // This is for testing only - member r.WaitForBackgroundOpCompletion() = - Trace.TraceInformation("Reactor: {0:n3} enqueue wait for background, length {0}", DateTime.Now.TimeOfDay.TotalSeconds, builder.CurrentQueueLength) + member _.WaitForBackgroundOpCompletion() = + Trace.TraceInformation("Reactor: {0:n3} enqueue wait for background, length {1}", DateTime.Now.TimeOfDay.TotalSeconds, builder.CurrentQueueLength) builder.PostAndReply WaitForBackgroundOpCompletion // This is for testing only - member r.CompleteAllQueuedOps() = - Trace.TraceInformation("Reactor: {0:n3} enqueue wait for all ops, length {0}", DateTime.Now.TimeOfDay.TotalSeconds, builder.CurrentQueueLength) + member _.CompleteAllQueuedOps() = + Trace.TraceInformation("Reactor: {0:n3} enqueue wait for all ops, length {1}", DateTime.Now.TimeOfDay.TotalSeconds, builder.CurrentQueueLength) builder.PostAndReply CompleteAllQueuedOps member r.EnqueueAndAwaitOpAsync (userOpName, opName, opArg, f) = diff --git a/src/fsharp/service/Reactor.fsi b/src/fsharp/service/Reactor.fsi index 598e6494ffe..f17caccc0ee 100755 --- a/src/fsharp/service/Reactor.fsi +++ b/src/fsharp/service/Reactor.fsi @@ -28,7 +28,8 @@ type internal Reactor = /// Set the background building function, which is called repeatedly /// until it returns 'false'. If None then no background operation is used. - member SetBackgroundOp : ( (* userOpName:*) string * (* opName: *) string * (* opArg: *) string * (CompilationThreadToken -> CancellationToken -> bool)) option -> unit + /// The operation is an Eventually which can be run in time slices. + member SetBackgroundOp : ( (* userOpName:*) string * (* opName: *) string * (* opArg: *) string * (CompilationThreadToken -> Eventually)) option -> unit /// Cancel any work being don by the background building function. member CancelBackgroundOp : unit -> unit diff --git a/src/fsharp/service/service.fs b/src/fsharp/service/service.fs index 6375fca5c04..30aab3c66bd 100644 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -267,7 +267,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC IncrementalBuilder.TryCreateIncrementalBuilderForProjectOptions (ctok, legacyReferenceResolver, FSharpCheckerResultsSettings.defaultFSharpBinariesDir, frameworkTcImportsCache, loadClosure, Array.toList options.SourceFiles, Array.toList options.OtherOptions, projectReferences, options.ProjectDirectory, - options.UseScriptResolutionRules, keepAssemblyContents, keepAllBackgroundResolutions, FSharpCheckerResultsSettings.maxTimeShareMilliseconds, + options.UseScriptResolutionRules, keepAssemblyContents, keepAllBackgroundResolutions, tryGetMetadataSnapshot, suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking, @@ -394,16 +394,15 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC hash (fun (f1, o1, v1) (f2, o2, v2) -> f1 = f2 && v1 = v2 && FSharpProjectOptions.AreSameForChecking(o1, o2))) - static let mutable foregroundParseCount = 0 + static let mutable actualParseFileCount = 0 - static let mutable foregroundTypeCheckCount = 0 + static let mutable actualCheckFileCount = 0 member _.RecordCheckFileInProjectResults(filename,options,parsingOptions,parseResults,fileVersion,priorTimeStamp,checkAnswer,sourceText) = match checkAnswer with - | None - | Some FSharpCheckFileAnswer.Aborted -> () - | Some (FSharpCheckFileAnswer.Succeeded typedResults) -> - foregroundTypeCheckCount <- foregroundTypeCheckCount + 1 + | None -> () + | Some typedResults -> + actualCheckFileCount <- actualCheckFileCount + 1 parseCacheLock.AcquireLock (fun ltok -> checkFileInProjectCachePossiblyStale.Set(ltok, (filename,options),(parseResults,typedResults,fileVersion)) checkFileInProjectCache.Set(ltok, (filename, sourceText, options),(parseResults,typedResults,fileVersion,priorTimeStamp)) @@ -420,7 +419,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC match parseCacheLock.AcquireLock(fun ltok -> parseFileCache.TryGet(ltok, (filename, hash, options))) with | Some res -> return res | None -> - foregroundParseCount <- foregroundParseCount + 1 + actualParseFileCount <- actualParseFileCount + 1 let parseDiags, parseTree, anyErrors = ParseAndCheckFile.parseFile(sourceText, filename, options, userOpName, suggestNamesForErrors) let res = FSharpParseFileResults(parseDiags, parseTree, anyErrors, options.SourceFiles) parseCacheLock.AcquireLock(fun ltok -> parseFileCache.Set(ltok, (filename, hash, options), res)) @@ -481,8 +480,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC builder: IncrementalBuilder, tcPrior: PartialCheckResults, tcInfo: TcInfo, - creationDiags: FSharpDiagnostic[], - userOpName: string) = + creationDiags: FSharpDiagnostic[]) = async { let beingCheckedFileKey = fileName, options, fileVersion @@ -514,8 +512,6 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC tcInfo.moduleNamesDict, loadClosure, tcInfo.TcErrors, - reactorOps, - userOpName, options.IsIncompleteTypeCheckEnvironment, options, builder, @@ -523,11 +519,11 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC creationDiags, parseResults.Diagnostics, keepAssemblyContents, - suggestNamesForErrors) + suggestNamesForErrors) |> Cancellable.toAsync let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, Array.ofList builder.SourceFiles, options.UseScriptResolutionRules) reactor.SetPreferredUILang tcConfig.preferredUiLang bc.RecordCheckFileInProjectResults(fileName, options, parsingOptions, parseResults, fileVersion, tcPrior.TimeStamp, Some checkAnswer, sourceText.GetHashCode()) - return checkAnswer + return FSharpCheckFileAnswer.Succeeded checkAnswer finally let dummy = ref () beingCheckedFileTable.TryRemove(beingCheckedFileKey, dummy) |> ignore @@ -576,7 +572,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC match tcPrior with | Some(tcPrior, tcInfo) -> - let! checkResults = bc.CheckOneFileImpl(parseResults, sourceText, filename, options, fileVersion, builder, tcPrior, tcInfo, creationDiags, userOpName) + let! checkResults = bc.CheckOneFileImpl(parseResults, sourceText, filename, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) return Some checkResults | None -> return None // the incremental builder was not up to date finally @@ -611,9 +607,10 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC execWithReactorAsync <| fun ctok -> cancellable { let! tcPrior = builder.GetCheckResultsBeforeFileInProject (ctok, filename) - return (tcPrior, tcPrior.GetTcInfo ctok) + let! tcInfo = tcPrior.GetTcInfo() |> Eventually.toCancellable + return (tcPrior, tcInfo) } - let! checkAnswer = bc.CheckOneFileImpl(parseResults, sourceText, filename, options, fileVersion, builder, tcPrior, tcInfo, creationDiags, userOpName) + let! checkAnswer = bc.CheckOneFileImpl(parseResults, sourceText, filename, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) return checkAnswer finally bc.ImplicitlyStartCheckProjectInBackground(options, userOpName) @@ -660,7 +657,8 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC execWithReactorAsync <| fun ctok -> cancellable { let! tcPrior = builder.GetCheckResultsBeforeFileInProject (ctok, filename) - return (tcPrior, tcPrior.GetTcInfo ctok) + let! tcInfo = tcPrior.GetTcInfo() |> Eventually.toCancellable + return (tcPrior, tcInfo) } // Do the parsing. @@ -668,7 +666,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC reactor.SetPreferredUILang tcPrior.TcConfig.preferredUiLang let parseDiags, parseTree, anyErrors = ParseAndCheckFile.parseFile (sourceText, filename, parsingOptions, userOpName, suggestNamesForErrors) let parseResults = FSharpParseFileResults(parseDiags, parseTree, anyErrors, builder.AllDependenciesDeprecated) - let! checkResults = bc.CheckOneFileImpl(parseResults, sourceText, filename, options, fileVersion, builder, tcPrior, tcInfo, creationDiags, userOpName) + let! checkResults = bc.CheckOneFileImpl(parseResults, sourceText, filename, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) Logger.LogBlockMessageStop (filename + strGuid + "-Successful") LogCompilerFunctionId.Service_ParseAndCheckFileInProject @@ -692,7 +690,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC let (parseTree, _, _, parseDiags) = builder.GetParseResultsForFile (filename) let! tcProj = builder.GetFullCheckResultsAfterFileInProject (ctok, filename) - let tcInfo, tcInfoExtras = tcProj.GetTcInfoWithExtras ctok + let! tcInfo, tcInfoExtras = tcProj.GetTcInfoWithExtras() |> Eventually.toCancellable let tcResolutionsRev = tcInfoExtras.tcResolutionsRev let tcSymbolUsesRev = tcInfoExtras.tcSymbolUsesRev @@ -739,17 +737,19 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC member _.FindReferencesInFile(filename: string, options: FSharpProjectOptions, symbol: FSharpSymbol, canInvalidateProject: bool, userOpName: string) = reactor.EnqueueAndAwaitOpAsync(userOpName, "FindReferencesInFile", filename, fun ctok -> cancellable { - let! builderOpt, _ = getOrCreateBuilderWithInvalidationFlag (ctok, options, canInvalidateProject, userOpName) - match builderOpt with - | None -> return Seq.empty - | Some builder -> - if builder.ContainsFile filename then - let! checkResults = builder.GetFullCheckResultsAfterFileInProject (ctok, filename) - match checkResults.TryGetItemKeyStore ctok with - | None -> return Seq.empty - | Some reader -> return reader.FindAll symbol.Item - else - return Seq.empty }) + let! builderOpt, _ = getOrCreateBuilderWithInvalidationFlag (ctok, options, canInvalidateProject, userOpName) + match builderOpt with + | None -> return Seq.empty + | Some builder -> + if builder.ContainsFile filename then + let! checkResults = builder.GetFullCheckResultsAfterFileInProject (ctok, filename) + let! keyStoreOpt = checkResults.TryGetItemKeyStore() |> Eventually.toCancellable + match keyStoreOpt with + | None -> return Seq.empty + | Some reader -> return reader.FindAll symbol.Item + else + return Seq.empty + }) member _.GetSemanticClassificationForFile(filename: string, options: FSharpProjectOptions, userOpName: string) = @@ -760,7 +760,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC | None -> return None | Some builder -> let! checkResults = builder.GetFullCheckResultsAfterFileInProject (ctok, filename) - let scopt = checkResults.GetSemanticClassification ctok + let! scopt = checkResults.GetSemanticClassification() |> Eventually.toCancellable match scopt with | None -> return None | Some sc -> return Some (sc.GetView ()) }) @@ -787,7 +787,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC let errorOptions = tcProj.TcConfig.errorSeverityOptions let fileName = TcGlobals.DummyFileNameForRangesWithoutASpecificLocation - let tcInfo, tcInfoExtras = tcProj.GetTcInfoWithExtras ctok + let! tcInfo, tcInfoExtras = tcProj.GetTcInfoWithExtras() |> Eventually.toCancellable let tcSymbolUses = tcInfoExtras.TcSymbolUses let topAttribs = tcInfo.topAttribs @@ -934,18 +934,17 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC }) member _.CheckProjectInBackground (options, userOpName) = - reactor.SetBackgroundOp (Some (userOpName, "CheckProjectInBackground", options.ProjectFileName, (fun ctok ct -> - // The creation of the background builder can't currently be cancelled - match getOrCreateBuilder (ctok, options, userOpName) |> Cancellable.run ct with - | ValueOrCancelled.Cancelled _ -> false - | ValueOrCancelled.Value (builderOpt,_) -> - match builderOpt with - | None -> false - | Some builder -> - // The individual steps of the background build - match builder.Step(ctok) |> Cancellable.run ct with - | ValueOrCancelled.Value v -> v - | ValueOrCancelled.Cancelled _ -> false))) + reactor.SetBackgroundOp + (Some(userOpName, "CheckProjectInBackground", options.ProjectFileName, + (fun ctok -> + eventually { + // Builder creation is not yet time-sliced. + let! builderOpt,_ = getOrCreateBuilder (ctok, options, userOpName) |> Eventually.ofCancellable + match builderOpt with + | None -> return () + | Some builder -> + return! builder.PopulatePartialCheckingResults (ctok) + }))) member _.StopBackgroundCompile () = reactor.SetBackgroundOp(None) @@ -996,9 +995,9 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC member _.ImplicitlyStartBackgroundWork with get() = implicitlyStartBackgroundWork and set v = implicitlyStartBackgroundWork <- v - static member GlobalForegroundParseCountStatistic = foregroundParseCount + static member ActualParseFileCount = actualParseFileCount - static member GlobalForegroundTypeCheckCountStatistic = foregroundTypeCheckCount + static member ActualCheckFileCount = actualCheckFileCount [] @@ -1286,8 +1285,15 @@ type FSharpChecker(legacyReferenceResolver, let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.GetProjectOptionsFromScript(filename, source, previewEnabled, loadedTimeStamp, otherFlags, useFsiAuxLib, useSdkRefs, sdkDirOverride, assumeDotNetFramework, optionsStamp, userOpName) - member _.GetProjectOptionsFromCommandLineArgs(projectFileName, argv, ?loadedTimeStamp) = + member _.GetProjectOptionsFromCommandLineArgs(projectFileName, argv, ?loadedTimeStamp, ?isInteractive, ?isEditing) = + let isEditing = defaultArg isEditing false + let isInteractive = defaultArg isInteractive false let loadedTimeStamp = defaultArg loadedTimeStamp DateTime.MaxValue // Not 'now', we don't want to force reloading + let argv = + let define = if isInteractive then "--define:INTERACTIVE" else "--define:COMPILED" + Array.append argv [| define |] + let argv = + if isEditing then Array.append argv [| "--define:EDITING" |] else argv { ProjectFileName = projectFileName ProjectId = None SourceFiles = [| |] // the project file names will be inferred from the ProjectOptions @@ -1300,10 +1306,11 @@ type FSharpChecker(legacyReferenceResolver, OriginalLoadReferences=[] Stamp = None } - member _.GetParsingOptionsFromCommandLineArgs(sourceFiles, argv, ?isInteractive) = + member _.GetParsingOptionsFromCommandLineArgs(sourceFiles, argv, ?isInteractive, ?isEditing) = + let isEditing = defaultArg isEditing false let isInteractive = defaultArg isInteractive false use errorScope = new ErrorScope() - let tcConfigBuilder = + let tcConfigB = TcConfigBuilder.CreateNew(legacyReferenceResolver, defaultFSharpBinariesDir=FSharpCheckerResultsSettings.defaultFSharpBinariesDir, reduceMemoryUsage=ReduceMemoryFlag.Yes, @@ -1315,12 +1322,19 @@ type FSharpChecker(legacyReferenceResolver, sdkDirOverride=None, rangeForErrors=range0) + // These defines are implied by the F# compiler + tcConfigB.conditionalCompilationDefines <- + let define = if isInteractive then "INTERACTIVE" else "COMPILED" + define :: tcConfigB.conditionalCompilationDefines + if isEditing then + tcConfigB.conditionalCompilationDefines <- "EDITING":: tcConfigB.conditionalCompilationDefines + // Apply command-line arguments and collect more source files if they are in the arguments - let sourceFilesNew = ApplyCommandLineArgs(tcConfigBuilder, sourceFiles, argv) - FSharpParsingOptions.FromTcConfigBuilder(tcConfigBuilder, Array.ofList sourceFilesNew, isInteractive), errorScope.Diagnostics + let sourceFilesNew = ApplyCommandLineArgs(tcConfigB, sourceFiles, argv) + FSharpParsingOptions.FromTcConfigBuilder(tcConfigB, Array.ofList sourceFilesNew, isInteractive), errorScope.Diagnostics - member ic.GetParsingOptionsFromCommandLineArgs(argv, ?isInteractive: bool) = - ic.GetParsingOptionsFromCommandLineArgs([], argv, ?isInteractive=isInteractive) + member ic.GetParsingOptionsFromCommandLineArgs(argv, ?isInteractive: bool, ?isEditing) = + ic.GetParsingOptionsFromCommandLineArgs([], argv, ?isInteractive=isInteractive, ?isEditing=isEditing) /// Begin background parsing the given project. member _.StartBackgroundCompile(options, ?userOpName) = @@ -1357,9 +1371,9 @@ type FSharpChecker(legacyReferenceResolver, member _.PauseBeforeBackgroundWork with get() = Reactor.Singleton.PauseBeforeBackgroundWork and set v = Reactor.Singleton.PauseBeforeBackgroundWork <- v - static member GlobalForegroundParseCountStatistic = BackgroundCompiler.GlobalForegroundParseCountStatistic + static member ActualParseFileCount = BackgroundCompiler.ActualParseFileCount - static member GlobalForegroundTypeCheckCountStatistic = BackgroundCompiler.GlobalForegroundTypeCheckCountStatistic + static member ActualCheckFileCount = BackgroundCompiler.ActualCheckFileCount member _.MaxMemoryReached = maxMemEvent.Publish diff --git a/src/fsharp/service/service.fsi b/src/fsharp/service/service.fsi index cf5725f18f5..0e5d5c9218e 100644 --- a/src/fsharp/service/service.fsi +++ b/src/fsharp/service/service.fsi @@ -171,9 +171,17 @@ type public FSharpChecker = /// An optional unique stamp for the options. /// An optional string used for tracing compiler operations associated with this request. member GetProjectOptionsFromScript: - filename: string * source: ISourceText * ?previewEnabled:bool * ?loadedTimeStamp: DateTime * - ?otherFlags: string[] * ?useFsiAuxLib: bool * ?useSdkRefs: bool * ?assumeDotNetFramework: bool * ?sdkDirOverride: string * - ?optionsStamp: int64 * ?userOpName: string + filename: string * + source: ISourceText * + ?previewEnabled:bool * + ?loadedTimeStamp: DateTime * + ?otherFlags: string[] * + ?useFsiAuxLib: bool * + ?useSdkRefs: bool * + ?assumeDotNetFramework: bool * + ?sdkDirOverride: string * + ?optionsStamp: int64 * + ?userOpName: string -> Async /// Get the FSharpProjectOptions implied by a set of command line arguments. @@ -181,12 +189,16 @@ type public FSharpChecker = /// Used to differentiate between projects and for the base directory of the project. /// The command line arguments for the project build. /// Indicates when the script was loaded into the editing environment, + /// Indicates that compilation should assume the EDITING define and related settings + /// Indicates that compilation should assume the INTERACTIVE define and related settings /// so that an 'unload' and 'reload' action will cause the script to be considered as a new project, /// so that references are re-resolved. member GetProjectOptionsFromCommandLineArgs: projectFileName: string * argv: string[] * - ?loadedTimeStamp: DateTime + ?loadedTimeStamp: DateTime * + ?isInteractive: bool * + ?isEditing: bool -> FSharpProjectOptions /// @@ -196,10 +208,12 @@ type public FSharpChecker = /// Initial source files list. Additional files may be added during argv evaluation. /// The command line arguments for the project build. /// Indicates that parsing should assume the INTERACTIVE define and related settings + /// Indicates that compilation should assume the EDITING define and related settings member GetParsingOptionsFromCommandLineArgs: sourceFiles: string list * argv: string list * - ?isInteractive: bool + ?isInteractive: bool * + ?isEditing: bool -> FSharpParsingOptions * FSharpDiagnostic list /// @@ -208,14 +222,21 @@ type public FSharpChecker = /// /// The command line arguments for the project build. /// Indicates that parsing should assume the INTERACTIVE define and related settings - member GetParsingOptionsFromCommandLineArgs: argv: string list * ?isInteractive: bool -> FSharpParsingOptions * FSharpDiagnostic list + /// Indicates that compilation should assume the EDITING define and related settings + member GetParsingOptionsFromCommandLineArgs: + argv: string list * + ?isInteractive: bool * + ?isEditing: bool + -> FSharpParsingOptions * FSharpDiagnostic list /// /// Get the FSharpParsingOptions implied by a FSharpProjectOptions. /// /// /// The overall options. - member GetParsingOptionsFromProjectOptions: options: FSharpProjectOptions -> FSharpParsingOptions * FSharpDiagnostic list + member GetParsingOptionsFromProjectOptions: + options: FSharpProjectOptions + -> FSharpParsingOptions * FSharpDiagnostic list /// /// Like ParseFile, but uses results from the background builder. @@ -359,10 +380,10 @@ type public FSharpChecker = member WaitForBackgroundCompile: unit -> unit /// Report a statistic for testability - static member GlobalForegroundParseCountStatistic: int + static member ActualParseFileCount: int /// Report a statistic for testability - static member GlobalForegroundTypeCheckCountStatistic: int + static member ActualCheckFileCount: int /// Flush all caches and garbage collect member ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients: unit -> unit diff --git a/src/fsharp/symbols/SymbolHelpers.fs b/src/fsharp/symbols/SymbolHelpers.fs index 82e613a3e56..ec61645da86 100644 --- a/src/fsharp/symbols/SymbolHelpers.fs +++ b/src/fsharp/symbols/SymbolHelpers.fs @@ -178,7 +178,7 @@ type internal CompilationErrorLogger (debugName: string, options: FSharpDiagnost member x.GetDiagnostics() = diagnostics.ToArray() -/// This represents the global state established as each task function runs as part of the build. +/// 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) = diff --git a/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs b/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs index ad4eb78ab85..55aca926c74 100644 --- a/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs +++ b/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs @@ -1425,16 +1425,16 @@ FSharp.Compiler.CodeAnalysis.FSharpChecker: Boolean get_ImplicitlyStartBackgroun FSharp.Compiler.CodeAnalysis.FSharpChecker: FSharp.Compiler.CodeAnalysis.FSharpChecker Create(Microsoft.FSharp.Core.FSharpOption`1[System.Int32], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.CodeAnalysis.LegacyReferenceResolver], Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Core.FSharpFunc`2[System.Tuple`2[System.String,System.DateTime],Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`3[System.Object,System.IntPtr,System.Int32]]]], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean]) FSharp.Compiler.CodeAnalysis.FSharpChecker: FSharp.Compiler.CodeAnalysis.FSharpChecker Instance FSharp.Compiler.CodeAnalysis.FSharpChecker: FSharp.Compiler.CodeAnalysis.FSharpChecker get_Instance() -FSharp.Compiler.CodeAnalysis.FSharpChecker: FSharp.Compiler.CodeAnalysis.FSharpProjectOptions GetProjectOptionsFromCommandLineArgs(System.String, System.String[], Microsoft.FSharp.Core.FSharpOption`1[System.DateTime]) +FSharp.Compiler.CodeAnalysis.FSharpChecker: FSharp.Compiler.CodeAnalysis.FSharpProjectOptions GetProjectOptionsFromCommandLineArgs(System.String, System.String[], Microsoft.FSharp.Core.FSharpOption`1[System.DateTime], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean]) FSharp.Compiler.CodeAnalysis.FSharpChecker: FSharp.Compiler.Tokenization.FSharpTokenInfo[][] TokenizeFile(System.String) +FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 ActualCheckFileCount +FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 ActualParseFileCount FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 CurrentQueueLength -FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 GlobalForegroundParseCountStatistic -FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 GlobalForegroundTypeCheckCountStatistic FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 MaxMemory FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 PauseBeforeBackgroundWork +FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 get_ActualCheckFileCount() +FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 get_ActualParseFileCount() FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 get_CurrentQueueLength() -FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 get_GlobalForegroundParseCountStatistic() -FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 get_GlobalForegroundTypeCheckCountStatistic() FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 get_MaxMemory() FSharp.Compiler.CodeAnalysis.FSharpChecker: Int32 get_PauseBeforeBackgroundWork() FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Control.FSharpAsync`1[FSharp.Compiler.CodeAnalysis.FSharpCheckFileAnswer] CheckFileInProject(FSharp.Compiler.CodeAnalysis.FSharpParseFileResults, System.String, Int32, FSharp.Compiler.Text.ISourceText, FSharp.Compiler.CodeAnalysis.FSharpProjectOptions, Microsoft.FSharp.Core.FSharpOption`1[System.String]) @@ -1466,8 +1466,8 @@ FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Control.IEvent`2[Mi FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Control.IEvent`2[Microsoft.FSharp.Control.FSharpHandler`1[System.Tuple`2[System.String,FSharp.Compiler.CodeAnalysis.FSharpProjectOptions]],System.Tuple`2[System.String,FSharp.Compiler.CodeAnalysis.FSharpProjectOptions]] get_FileChecked() FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Control.IEvent`2[Microsoft.FSharp.Control.FSharpHandler`1[System.Tuple`2[System.String,FSharp.Compiler.CodeAnalysis.FSharpProjectOptions]],System.Tuple`2[System.String,FSharp.Compiler.CodeAnalysis.FSharpProjectOptions]] get_FileParsed() FSharp.Compiler.CodeAnalysis.FSharpChecker: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`3[FSharp.Compiler.CodeAnalysis.FSharpParseFileResults,FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults,System.Int32]] TryGetRecentCheckResultsForFile(System.String, FSharp.Compiler.CodeAnalysis.FSharpProjectOptions, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.ISourceText], Microsoft.FSharp.Core.FSharpOption`1[System.String]) -FSharp.Compiler.CodeAnalysis.FSharpChecker: System.Tuple`2[FSharp.Compiler.CodeAnalysis.FSharpParsingOptions,Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Diagnostics.FSharpDiagnostic]] GetParsingOptionsFromCommandLineArgs(Microsoft.FSharp.Collections.FSharpList`1[System.String], Microsoft.FSharp.Collections.FSharpList`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean]) -FSharp.Compiler.CodeAnalysis.FSharpChecker: System.Tuple`2[FSharp.Compiler.CodeAnalysis.FSharpParsingOptions,Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Diagnostics.FSharpDiagnostic]] GetParsingOptionsFromCommandLineArgs(Microsoft.FSharp.Collections.FSharpList`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean]) +FSharp.Compiler.CodeAnalysis.FSharpChecker: System.Tuple`2[FSharp.Compiler.CodeAnalysis.FSharpParsingOptions,Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Diagnostics.FSharpDiagnostic]] GetParsingOptionsFromCommandLineArgs(Microsoft.FSharp.Collections.FSharpList`1[System.String], Microsoft.FSharp.Collections.FSharpList`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean]) +FSharp.Compiler.CodeAnalysis.FSharpChecker: System.Tuple`2[FSharp.Compiler.CodeAnalysis.FSharpParsingOptions,Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Diagnostics.FSharpDiagnostic]] GetParsingOptionsFromCommandLineArgs(Microsoft.FSharp.Collections.FSharpList`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean], Microsoft.FSharp.Core.FSharpOption`1[System.Boolean]) FSharp.Compiler.CodeAnalysis.FSharpChecker: System.Tuple`2[FSharp.Compiler.CodeAnalysis.FSharpParsingOptions,Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Diagnostics.FSharpDiagnostic]] GetParsingOptionsFromProjectOptions(FSharp.Compiler.CodeAnalysis.FSharpProjectOptions) FSharp.Compiler.CodeAnalysis.FSharpChecker: System.Tuple`2[FSharp.Compiler.Tokenization.FSharpTokenInfo[],FSharp.Compiler.Tokenization.FSharpTokenizerLexState] TokenizeLine(System.String, FSharp.Compiler.Tokenization.FSharpTokenizerLexState) FSharp.Compiler.CodeAnalysis.FSharpChecker: Void CheckProjectInBackground(FSharp.Compiler.CodeAnalysis.FSharpProjectOptions, Microsoft.FSharp.Core.FSharpOption`1[System.String]) @@ -3512,7 +3512,6 @@ FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: FsiEvaluationSessionHost FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: FsiEvaluationSessionHostConfig GetDefaultConfiguration(System.Object) FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: FsiEvaluationSessionHostConfig GetDefaultConfiguration(System.Object, Boolean) FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Interactive.Shell+FsiBoundValue] GetBoundValues() -FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Microsoft.FSharp.Control.FSharpAsync`1[System.Tuple`3[FSharp.Compiler.CodeAnalysis.FSharpParseFileResults,FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults,FSharp.Compiler.CodeAnalysis.FSharpCheckProjectResults]] ParseAndCheckInteraction(System.String) FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Microsoft.FSharp.Control.IEvent`2[Microsoft.FSharp.Control.FSharpHandler`1[Microsoft.FSharp.Core.Unit],Microsoft.FSharp.Core.Unit] PartialAssemblySignatureUpdated FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Microsoft.FSharp.Control.IEvent`2[Microsoft.FSharp.Control.FSharpHandler`1[Microsoft.FSharp.Core.Unit],Microsoft.FSharp.Core.Unit] get_PartialAssemblySignatureUpdated() FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Microsoft.FSharp.Control.IEvent`2[Microsoft.FSharp.Control.FSharpHandler`1[System.Tuple`3[System.Object,System.Type,System.String]],System.Tuple`3[System.Object,System.Type,System.String]] ValueBound @@ -3528,6 +3527,7 @@ FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: System.String FormatValu FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: System.Tuple`2[Microsoft.FSharp.Core.FSharpChoice`2[Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Interactive.Shell+FsiValue],System.Exception],FSharp.Compiler.Diagnostics.FSharpDiagnostic[]] EvalExpressionNonThrowing(System.String) FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: System.Tuple`2[Microsoft.FSharp.Core.FSharpChoice`2[Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Interactive.Shell+FsiValue],System.Exception],FSharp.Compiler.Diagnostics.FSharpDiagnostic[]] EvalInteractionNonThrowing(System.String, Microsoft.FSharp.Core.FSharpOption`1[System.Threading.CancellationToken]) FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: System.Tuple`2[Microsoft.FSharp.Core.FSharpChoice`2[Microsoft.FSharp.Core.Unit,System.Exception],FSharp.Compiler.Diagnostics.FSharpDiagnostic[]] EvalScriptNonThrowing(System.String) +FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: System.Tuple`3[FSharp.Compiler.CodeAnalysis.FSharpParseFileResults,FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults,FSharp.Compiler.CodeAnalysis.FSharpCheckProjectResults] ParseAndCheckInteraction(System.String) FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Void AddBoundValue(System.String, System.Object) FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Void EvalInteraction(System.String, Microsoft.FSharp.Core.FSharpOption`1[System.Threading.CancellationToken]) FSharp.Compiler.Interactive.Shell+FsiEvaluationSession: Void EvalScript(System.String) diff --git a/tests/FSharp.Test.Utilities/ScriptHelpers.fs b/tests/FSharp.Test.Utilities/ScriptHelpers.fs index 1d169d6692a..afb592b8c72 100644 --- a/tests/FSharp.Test.Utilities/ScriptHelpers.fs +++ b/tests/FSharp.Test.Utilities/ScriptHelpers.fs @@ -122,7 +122,7 @@ type FSharpScript(?additionalArgs: string[], ?quiet: bool, ?langVersion: LangVer /// The 0-based column index member _.GetCompletionItems(text: string, line: int, column: int) = async { - let! parseResults, checkResults, _projectResults = fsi.ParseAndCheckInteraction(text) + let parseResults, checkResults, _projectResults = fsi.ParseAndCheckInteraction(text) let lineText = text.Split('\n').[line - 1] let partialName = QuickParse.GetPartialLongNameEx(lineText, column - 1) let declarationListInfos = checkResults.GetDeclarationListInfo(Some parseResults, line, lineText, partialName) diff --git a/tests/service/PerfTests.fs b/tests/service/PerfTests.fs index 140f9f7c848..5b77c6d2f59 100644 --- a/tests/service/PerfTests.fs +++ b/tests/service/PerfTests.fs @@ -44,11 +44,11 @@ let ``Test request for parse and check doesn't check whole project`` () = checker.FileParsed.Add (fun x -> incr backgroundParseCount) checker.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() - let pB, tB = FSharpChecker.GlobalForegroundParseCountStatistic, FSharpChecker.GlobalForegroundTypeCheckCountStatistic + let pB, tB = FSharpChecker.ActualParseFileCount, FSharpChecker.ActualCheckFileCount printfn "ParseFile()..." let parseResults1 = checker.ParseFile(Project1.fileNames.[5], Project1.fileSources2.[5], Project1.parsingOptions) |> Async.RunSynchronously - let pC, tC = FSharpChecker.GlobalForegroundParseCountStatistic, FSharpChecker.GlobalForegroundTypeCheckCountStatistic + let pC, tC = FSharpChecker.ActualParseFileCount, FSharpChecker.ActualCheckFileCount (pC - pB) |> shouldEqual 1 (tC - tB) |> shouldEqual 0 printfn "checking backgroundParseCount.Value = %d" backgroundParseCount.Value @@ -58,7 +58,7 @@ let ``Test request for parse and check doesn't check whole project`` () = printfn "CheckFileInProject()..." let checkResults1 = checker.CheckFileInProject(parseResults1, Project1.fileNames.[5], 0, Project1.fileSources2.[5], Project1.options) |> Async.RunSynchronously - let pD, tD = FSharpChecker.GlobalForegroundParseCountStatistic, FSharpChecker.GlobalForegroundTypeCheckCountStatistic + let pD, tD = FSharpChecker.ActualParseFileCount, FSharpChecker.ActualCheckFileCount printfn "checking background parsing happened...., backgroundParseCount.Value = %d" backgroundParseCount.Value (backgroundParseCount.Value >= 5) |> shouldEqual true // but note, the project does not get reparsed @@ -77,7 +77,7 @@ let ``Test request for parse and check doesn't check whole project`` () = printfn "CheckFileInProject()..." let checkResults2 = checker.CheckFileInProject(parseResults1, Project1.fileNames.[7], 0, Project1.fileSources2.[7], Project1.options) |> Async.RunSynchronously - let pE, tE = FSharpChecker.GlobalForegroundParseCountStatistic, FSharpChecker.GlobalForegroundTypeCheckCountStatistic + let pE, tE = FSharpChecker.ActualParseFileCount, FSharpChecker.ActualCheckFileCount printfn "checking no extra foreground parsing...., (pE - pD) = %d" (pE - pD) (pE - pD) |> shouldEqual 0 printfn "checking one foreground typecheck...., tE - tD = %d" (tE - tD) @@ -90,7 +90,7 @@ let ``Test request for parse and check doesn't check whole project`` () = printfn "ParseAndCheckFileInProject()..." // A subsequent ParseAndCheck of identical source code doesn't do any more anything let checkResults2 = checker.ParseAndCheckFileInProject(Project1.fileNames.[7], 0, Project1.fileSources2.[7], Project1.options) |> Async.RunSynchronously - let pF, tF = FSharpChecker.GlobalForegroundParseCountStatistic, FSharpChecker.GlobalForegroundTypeCheckCountStatistic + let pF, tF = FSharpChecker.ActualParseFileCount, FSharpChecker.ActualCheckFileCount printfn "checking no extra foreground parsing...." (pF - pE) |> shouldEqual 0 // note, no new parse of the file printfn "checking no extra foreground typechecks...." diff --git a/tests/service/ProjectAnalysisTests.fs b/tests/service/ProjectAnalysisTests.fs index b5a8883ae46..341f5f236c3 100644 --- a/tests/service/ProjectAnalysisTests.fs +++ b/tests/service/ProjectAnalysisTests.fs @@ -4564,7 +4564,7 @@ module internal Project36 = let base2 = Path.GetTempFileName() let dllName = Path.ChangeExtension(base2, ".dll") let projFileName = Path.ChangeExtension(base2, ".fsproj") - let fileSource1 = """ + let fileSource1 = """module Project36 type A(i:int) = member x.Value = i @@ -4584,26 +4584,16 @@ let callToOverload = B(5).Overload(4) let fileNames = [fileName1] let args = mkProjectCommandLineArgs (dllName, fileNames) + +[] +let ``Test project36 FSharpMemberOrFunctionOrValue.IsBaseValue`` () = let keepAssemblyContentsChecker = FSharpChecker.Create(keepAssemblyContents=true) - let options = keepAssemblyContentsChecker.GetProjectOptionsFromCommandLineArgs (projFileName, args) + let options = keepAssemblyContentsChecker.GetProjectOptionsFromCommandLineArgs (Project36.projFileName, Project36.args) let wholeProjectResults = keepAssemblyContentsChecker.ParseAndCheckProject(options) |> Async.RunSynchronously - let declarations = - let checkedFile = wholeProjectResults.AssemblyContents.ImplementationFiles.[0] - match checkedFile.Declarations.[0] with - | FSharpImplementationFileDeclaration.Entity (_, subDecls) -> subDecls - | _ -> failwith "unexpected declaration" - let getExpr exprIndex = - match declarations.[exprIndex] with - | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(_,_,e) -> e - | FSharpImplementationFileDeclaration.InitAction e -> e - | _ -> failwith "unexpected declaration" - -[] -let ``Test project36 FSharpMemberOrFunctionOrValue.IsBaseValue`` () = - Project36.wholeProjectResults.GetAllUsesOfAllSymbols() + wholeProjectResults.GetAllUsesOfAllSymbols() |> Array.pick (fun (su:FSharpSymbolUse) -> if su.Symbol.DisplayName = "base" then Some (su.Symbol :?> FSharpMemberOrFunctionOrValue) @@ -4612,7 +4602,9 @@ let ``Test project36 FSharpMemberOrFunctionOrValue.IsBaseValue`` () = [] let ``Test project36 FSharpMemberOrFunctionOrValue.IsConstructorThisValue & IsMemberThisValue`` () = - let wholeProjectResults = Project36.keepAssemblyContentsChecker.ParseAndCheckProject(Project36.options) |> Async.RunSynchronously + let keepAssemblyContentsChecker = FSharpChecker.Create(keepAssemblyContents=true) + let options = keepAssemblyContentsChecker.GetProjectOptionsFromCommandLineArgs (Project36.projFileName, Project36.args) + let wholeProjectResults = keepAssemblyContentsChecker.ParseAndCheckProject(options) |> Async.RunSynchronously let declarations = let checkedFile = wholeProjectResults.AssemblyContents.ImplementationFiles.[0] match checkedFile.Declarations.[0] with @@ -4627,19 +4619,19 @@ let ``Test project36 FSharpMemberOrFunctionOrValue.IsConstructorThisValue & IsMe // the correct values are also visible from there. Also note you cannot use // ThisValue in these cases, this is only used when the symbol // is implicit in the constructor - match Project36.getExpr 4 with + match getExpr 4 with | Let((b,_),_) -> b.IsConstructorThisValue && not b.IsMemberThisValue | _ -> failwith "unexpected expression" |> shouldEqual true - match Project36.getExpr 5 with + match getExpr 5 with | FSharpFieldGet(Some(Value x),_,_) -> x.IsMemberThisValue && not x.IsConstructorThisValue | _ -> failwith "unexpected expression" |> shouldEqual true - match Project36.getExpr 6 with + match getExpr 6 with | Call(_,_,_,_,[Value s;_]) -> not s.IsMemberThisValue && not s.IsConstructorThisValue | _ -> failwith "unexpected expression" @@ -4647,7 +4639,9 @@ let ``Test project36 FSharpMemberOrFunctionOrValue.IsConstructorThisValue & IsMe [] let ``Test project36 FSharpMemberOrFunctionOrValue.LiteralValue`` () = - let wholeProjectResults = Project36.keepAssemblyContentsChecker.ParseAndCheckProject(Project36.options) |> Async.RunSynchronously + let keepAssemblyContentsChecker = FSharpChecker.Create(keepAssemblyContents=true) + let options = keepAssemblyContentsChecker.GetProjectOptionsFromCommandLineArgs (Project36.projFileName, Project36.args) + let wholeProjectResults = keepAssemblyContentsChecker.ParseAndCheckProject(options) |> Async.RunSynchronously let project36Module = wholeProjectResults.AssemblySignature.Entities.[0] let lit = project36Module.MembersFunctionsAndValues.[0] shouldEqual true (lit.LiteralValue.Value |> unbox |> (=) 1.) @@ -5209,7 +5203,8 @@ let foo (a: Foo): bool = [] let ``Test typed AST for struct unions`` () = // See https://github.com/fsharp/FSharp.Compiler.Service/issues/756 - let wholeProjectResults = Project36.keepAssemblyContentsChecker.ParseAndCheckProject(ProjectStructUnions.options) |> Async.RunSynchronously + let keepAssemblyContentsChecker = FSharpChecker.Create(keepAssemblyContents=true) + let wholeProjectResults = keepAssemblyContentsChecker.ParseAndCheckProject(ProjectStructUnions.options) |> Async.RunSynchronously let declarations = let checkedFile = wholeProjectResults.AssemblyContents.ImplementationFiles.[0] match checkedFile.Declarations.[0] with diff --git a/vsintegration/src/FSharp.LanguageService/FSharpSource.fs b/vsintegration/src/FSharp.LanguageService/FSharpSource.fs index 2136681f55a..b311983e6b4 100644 --- a/vsintegration/src/FSharp.LanguageService/FSharpSource.fs +++ b/vsintegration/src/FSharp.LanguageService/FSharpSource.fs @@ -355,6 +355,7 @@ type internal FSharpSource_DEPRECATED(service:LanguageService_DEPRECATED, textLi yield! pi.CompilationOptions |> Array.filter(fun flag -> flag.StartsWith("--define:")) | None -> () yield "--noframework" + yield "--define:COMPILED" |] // get a sync parse of the file diff --git a/vsintegration/tests/UnitTests/TestLib.LanguageService.fs b/vsintegration/tests/UnitTests/TestLib.LanguageService.fs index dc3d649200d..c33223c6ff0 100644 --- a/vsintegration/tests/UnitTests/TestLib.LanguageService.fs +++ b/vsintegration/tests/UnitTests/TestLib.LanguageService.fs @@ -159,7 +159,7 @@ type internal GlobalParseAndTypeCheckCounter private(initialParseCount:int, init static member StartNew(vs) = TakeCoffeeBreak(vs) let n = IncrementalBuilderEventTesting.GetCurrentIncrementalBuildEventNum() - new GlobalParseAndTypeCheckCounter(FSharpChecker.GlobalForegroundParseCountStatistic, FSharpChecker.GlobalForegroundTypeCheckCountStatistic, n, vs) + new GlobalParseAndTypeCheckCounter(FSharpChecker.ActualParseFileCount, FSharpChecker.ActualCheckFileCount, n, vs) member private this.GetEvents() = TakeCoffeeBreak(vs) let n = IncrementalBuilderEventTesting.GetCurrentIncrementalBuildEventNum()