From 482f0742423c60527704c5253f922146700a137f Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Sat, 23 Nov 2024 11:05:06 -0500 Subject: [PATCH 1/5] transparent compiler nicecites --- .vscode/settings.json | 9 +- benchmarks/benchmarks.fsproj | 5 + global.json | 5 +- playground.fsx | 571 ++++++++++++++++++ .../AbstractClassStubGenerator.fs | 2 +- src/FsAutoComplete.Core/AdaptiveExtensions.fs | 65 +- src/FsAutoComplete.Core/Commands.fs | 13 +- .../CompilerServiceInterface.fs | 53 +- src/FsAutoComplete.Core/FCSPatches.fs | 6 +- src/FsAutoComplete.Core/FileSystem.fs | 6 +- src/FsAutoComplete.Core/FileSystem.fsi | 2 +- .../FsAutoComplete.Core.fsproj | 4 + src/FsAutoComplete.Core/SemaphoreSlimLocks.fs | 11 +- .../SemaphoreSlimLocks.fsi | 23 +- src/FsAutoComplete.Core/TestAdapter.fs | 6 +- .../UnionPatternMatchCaseGenerator.fs | 6 +- src/FsAutoComplete.Core/UntypedAstUtils.fs | 4 +- src/FsAutoComplete.Core/Utils.fs | 9 +- src/FsAutoComplete/FsAutoComplete.fsproj | 4 + src/FsAutoComplete/LspHelpers.fs | 6 +- src/FsAutoComplete/LspHelpers.fsi | 6 +- .../LspServers/AdaptiveFSharpLspServer.fs | 10 +- .../LspServers/AdaptiveServerState.fs | 81 ++- src/FsAutoComplete/LspServers/Common.fs | 49 +- .../LspServers/FSharpLspClient.fs | 12 +- .../LspServers/FSharpLspClient.fsi | 6 +- .../FsAutoComplete.Tests.Lsp/SnapshotTests.fs | 2 +- test/FsAutoComplete.Tests.Lsp/Utils/Server.fs | 3 +- 28 files changed, 832 insertions(+), 147 deletions(-) create mode 100644 playground.fsx diff --git a/.vscode/settings.json b/.vscode/settings.json index dcba1403b..68066a306 100644 --- a/.vscode/settings.json +++ b/.vscode/settings.json @@ -8,7 +8,7 @@ //otherwise take a lot of time to load proj inside //the test directories "omnisharp.autoStart": false, - "FSharp.trace.server": "off", + "FSharp.trace.server": "verbose", "yaml.schemas": { "https://raw.githubusercontent.com/SchemaStore/schemastore/master/src/schemas/json/github-workflow.json": ".github/workflows/*" }, @@ -164,5 +164,10 @@ "whitespaces", "xrtt", "xunit" - ] + ], + "FSharp.lineLens.enabled": "replaceCodeLens", + "FSharp.codeLenses.signature.enabled": false, + "FSharp.verboseLogging": true, + "FSharp.fcs.transparentCompiler.enabled": true, + "FSharp.fsac.netCoreDllPath": "C:\\Users\\jimmy\\Repositories\\public\\TheAngryByrd\\FsAutoComplete\\src\\FsAutoComplete\\bin\\Release\\" } diff --git a/benchmarks/benchmarks.fsproj b/benchmarks/benchmarks.fsproj index 10ca6a14d..3f3603d6a 100644 --- a/benchmarks/benchmarks.fsproj +++ b/benchmarks/benchmarks.fsproj @@ -4,6 +4,11 @@ Exe net8.0 net8.0;net9.0 + net8.0;net9.0 + + + net8.0 + $(TargetFrameworks);net9.0 diff --git a/global.json b/global.json index 689afa9ed..2bc13e80a 100644 --- a/global.json +++ b/global.json @@ -1,7 +1,6 @@ { "sdk": { - "version": "8.0.300", - "rollForward": "latestMajor", - "allowPrerelease": true + "version": "9.0.100", + "rollForward": "latestMinor" } } diff --git a/playground.fsx b/playground.fsx new file mode 100644 index 000000000..3e7e9aa75 --- /dev/null +++ b/playground.fsx @@ -0,0 +1,571 @@ +open System +open System.Collections +open System.Collections.Generic +open System.Runtime.ExceptionServices + +#r "nuget: Microsoft.Extensions.Logging" +open Microsoft.Extensions.Logging + +[] +module private LibInternals = + type ILL = InlineIfLambdaAttribute + +[] +module Library = + + let inline ``panic!`` (message: string) : 'T = + try + raise (InvalidProgramException message) + with x -> + Environment.FailFast("Fatal error; program must exit!", x) + Unchecked.defaultof<'T> + + +[] +type IFault = + abstract Message: string + abstract Cause: IFault option + + +type Demotion<'X when 'X :> exn>(source: 'X, ?message: string) = + member _.Source: 'X = source + + member val Message: string = defaultArg message source.Message + + interface IFault with + member me.Message = me.Message + member _.Cause = None + + +type DemotionDI<'X when 'X :> exn> internal (edi: ExceptionDispatchInfo, ?message: string) = + inherit Demotion<'X>(edi.SourceException :?> 'X, ?message = message) + member _.ExceptionDispatchInfo = edi + member inline _.Rethrow() = edi.Throw() + +type Faulty<'T when 'T: (member Message: string)> = 'T + + +[] +module Fault = + let inline demote (source: 'X :> exn) = Demotion<'X>(source) + + let inline capture (source: 'X :> exn) = ExceptionDispatchInfo.Capture(source) |> DemotionDI<'X> + + let inline demoteAggregate (source: AggregateException) = + let exs = source.Flatten() + + if 1 = exs.InnerExceptions.Count then + demote exs.InnerExceptions.[0] + else + demote source + + let inline derive<'T when Faulty<'T>> (faulty: 'T) : IFault = + match box faulty with + | :? IFault as fault -> fault + | :? exn as source -> Demotion source + | _ -> + { new IFault with + member _.Message = faulty.Message + member _.Cause = None } + + let inline promote ([] toExn: IFault -> 'X) (fault: IFault) : 'X :> exn = toExn fault + + let inline escalate ([] toExn: IFault -> 'X) (fault: IFault) : 'X :> exn = fault |> promote toExn |> raise + + let inline repromote ([] wrapper: exn -> exn) (fault: Demotion<'X>) = fault.Source |> wrapper |> raise + + +[] +[] +type Report<'Pass, 'Fail when 'Fail :> IFault> = + | Pass of value: 'Pass + | Fail of fault: 'Fail + + static member inline op_Implicit(report: Report<'Pass, 'Fail>) : Result<'Pass, 'Fail> = + match report with + | Pass(value: 'Pass) -> Ok value + | Fail(error: 'Fail) -> Error error + + static member inline op_Implicit(result: Result<'Pass, 'Fail>) : Report<'Pass, 'Fail> = + match result with + | Ok(value: 'Pass) -> Pass value + | Error(error: 'Fail) -> Fail error + + +[] +module Patterns = + open System + open System.Threading.Tasks + + [] + let inline (|FailAs|_|) (report: Report<'Pass, IFault>) : 'Fail voption when 'Fail :> IFault = + match report with + | Fail(:? 'Fail as fault) -> ValueSome fault + | Fail _ + | Pass _ -> ValueNone + + [] + let inline (|DemotedAs|_|) (fault: IFault) : 'X voption when 'X :> exn = + match fault with + | :? Demotion<'X> as x -> ValueSome x.Source + | :? Demotion as x when (x.Source :? 'X) -> ValueSome(downcast x.Source) + | _ -> ValueNone + + [] + let inline (|Demoted|_|) (report: Report<'Pass, IFault>) = + match report with + | Fail(DemotedAs(demoted: 'X)) -> ValueSome demoted + | _ -> ValueNone + + [] + let inline (|OperationCanceledException|_|) (report: Report<'Pass, IFault>) = + match report with + | Demoted(c: OperationCanceledException) -> ValueSome() + | _ -> ValueNone + + [] + let inline (|TaskCanceledException|_|) (report: Report<'Pass, IFault>) = + match report with + | Demoted(c: TaskCanceledException) -> ValueSome() + | _ -> ValueNone + + + + +[] +module Report = + let inline ofFault (fault: IFault) : Report<'Pass, IFault> = Fail fault + + let inline ofExn (fault: 'X) : Report<'Pass, Demotion<'X>> = fault |> Demotion<_> |> Fail + + let inline bind ([] pass: 'Pass -> Report<'T, 'Fail>) (report: Report<'Pass, 'Fail>) : Report<'T, 'Fail> = + match report with + | Pass value -> pass value + | Fail error -> Fail error + + let inline bindFail ([] fail: 'Fail -> Report<'Pass, 'T>) (report: Report<'Pass, 'Fail>) : Report<'Pass, 'T> = + match report with + | Pass value -> Pass value + | Fail error -> fail error + + let inline map ([] pass: 'Pass -> 'T) (report: Report<'Pass, 'Fail>) : Report<'T, 'Fail> = + report |> bind (pass >> Pass) + + let inline mapFail ([] fail: 'Fail -> 'T) (report: Report<'Pass, 'Fail>) : Report<'Pass, 'T> = + report |> bindFail (fail >> Fail) + + let inline generalize (report: Report<'Pass, 'Fail>) : Report<'Pass, IFault> = + report |> mapFail (fun fault -> upcast fault) + + let inline iter ([] pass: 'Pass -> unit) (report: Report<'Pass, 'Fail>) : unit = + match report with + | Pass value -> pass value + | Fail _ -> ( (* noop *) ) + + let inline iterFail ([] fail: 'Fail -> unit) (report: Report<'Pass, 'Fail>) : unit = + match report with + | Pass _ -> ( (* noop *) ) + | Fail fault -> fail fault + + let inline isPass (report: Report<'Pass, 'Fail>) : bool = + match report with + | Pass _ -> true + | Fail _ -> false + + let inline isFail (report: Report<'Pass, 'Fail>) : bool = + match report with + | Pass _ -> false + | Fail _ -> true + + let inline toResult (report: Report<'Pass, 'Fail>) : Result<'Pass, 'Fail> = Report.op_Implicit report + + let inline ofResult (result: Result<'Pass, 'Fail>) : Report<'Pass, 'Fail> = Report.op_Implicit result + + let inline toOption (report: Report<'Pass, 'Fail>) : 'Pass option = + match report with + | Pass value -> Some value + | Fail _ -> None + + let inline ofOption ([] withFault: unit -> 'Fail) (option: 'Pass option) : Report<'Pass, 'Fail> = + match option with + | Some value -> Pass value + | None -> Fail(withFault ()) + + let inline toChoice (report: Report<'Pass, 'Fail>) : Choice<'Pass, 'Fail> = + match report with + | Pass value -> Choice1Of2 value + | Fail fault -> Choice2Of2 fault + + let inline ofChoice (choice: Choice<'Pass, 'Fail>) : Report<'Pass, 'Fail> = + match choice with + | Choice1Of2 value -> Pass value + | Choice2Of2 fault -> Fail fault + + let inline defaultValue (value: 'Pass) (report: Report<'Pass, 'Fail>) : 'Pass = + match report with + | Pass value' -> value' + | Fail _ -> value + + let inline defaultWith ([] withFault: 'Fail -> 'Pass) (report: Report<'Pass, 'Fail>) : 'Pass = + match report with + | Pass value -> value + | Fail fault -> withFault fault + + +[] +type CompoundFault(faults: IFault seq, ?message: string, ?cause: IFault) = + do (* .ctor *) + if isNull faults then + nullArg (nameof faults) + elif Seq.length faults < 1 then + invalidArg (nameof faults) "Must provide at least one fault." + + member val Faults: IFault seq = faults |> Seq.toArray |> Seq.readonly + + member val Message: string = defaultArg message "One or more errors occurred" + + interface IFault with + member me.Message = me.Message + member _.Cause = cause + + interface IEnumerable with + member me.GetEnumerator() = me.Faults.GetEnumerator() + member me.GetEnumerator() = (me.Faults :> IEnumerable).GetEnumerator() + + +[] +module Array = + open Microsoft.FSharp.Core.CompilerServices + + let inline divide (items: Report<'Pass, 'Fail> array) : 'Pass array * 'Fail array = + if isNull items then + nullArg (nameof items) + elif 0 = Array.length items then + (Array.empty, Array.empty) + else + + let mutable passing, failing = ArrayCollector<'Pass>(), ArrayCollector<_>() + + for item in items do + match item with + | Pass value -> passing.Add(value) + | Fail fault -> failing.Add(fault) + + (passing.Close(), failing.Close()) + + let inline accumulate ([] project: 'T -> Report<'Pass, IFault>) (items: 'T array) : Report<'Pass array, CompoundFault> = + if isNull items then + nullArg (nameof items) + elif 0 = Array.length items then + Pass Array.empty + else + let mutable passing, failing = ArrayCollector<'Pass>(), ArrayCollector<_>() + + for item in items do + match project item with + | Pass value -> passing.Add(value) + | Fail error -> failing.Add(error) + + let failing = failing.Close() + + if 0 < failing.Length then + Fail(CompoundFault failing) + else + Pass(passing.Close()) + + let inline traverse ([] project: 'T -> Report<'Pass, IFault>) (items: 'T array) : Report<'Pass array, IFault> = + if isNull items then + nullArg (nameof items) + elif 0 = Array.length items then + Pass Array.empty + else + let mutable buffer = ArrayCollector<'Pass>() + let mutable halted = ValueOption.None + let enum = (items :> 'T seq).GetEnumerator() + + while ValueOption.isNone halted && enum.MoveNext() do + match project enum.Current with + | Pass value -> buffer.Add(value) + | Fail error -> halted <- ValueSome error + + match halted with + | ValueSome error -> Fail error + | ValueNone -> Pass(buffer.Close()) + + let inline sequence (reports: Report<'Pass, IFault> array) : Report<'Pass array, IFault> = reports |> traverse id + + +[] +module List = + open Microsoft.FSharp.Core.CompilerServices + + let inline divide (items: Report<'Pass, 'Fail> list) : 'Pass list * 'Fail list = + match items with + | [] -> (List.empty, List.empty) + | items -> + let mutable passing, failing = ListCollector<'Pass>(), ListCollector<_>() + + for item in items do + match item with + | Pass value -> passing.Add(value) + | Fail fault -> failing.Add(fault) + + (passing.Close(), failing.Close()) + + let inline accumulate ([]project: 'T -> Report<'Pass, IFault>) (items: 'T list) : Report<'Pass list, CompoundFault> = + match items with + | [] -> Pass List.empty + | items -> + let mutable passing, failing = ListCollector<'Pass>(), ArrayCollector<_>() + + for item in items do + match project item with + | Pass value -> passing.Add(value) + | Fail error -> failing.Add(error) + + let failing = failing.Close() + + if 0 < failing.Length then + Fail(CompoundFault failing) + else + Pass(passing.Close()) + + let inline traverse ([] project: 'T -> Report<'Pass, IFault>) (items: 'T list) : Report<'Pass list, IFault> = + match items with + | [] -> Pass List.empty + | items -> + let mutable buffer = ListCollector<'Pass>() + let mutable halted = ValueOption.None + let enum = (items :> 'T seq).GetEnumerator() + + while ValueOption.isNone halted && enum.MoveNext() do + match project enum.Current with + | Pass value -> buffer.Add(value) + | Fail error -> halted <- ValueSome error + + match halted with + | ValueSome error -> Fail error + | ValueNone -> Pass(buffer.Close()) + + let inline sequence (reports: Report<'Pass, IFault> list) : Report<'Pass list, IFault> = reports |> traverse id + + +[] +module Seq = + let inline divide (items: Report<'Pass, 'Fail> seq) : 'Pass seq * 'Fail seq = + let passing, failing = items |> Seq.toArray |> Array.divide + (Seq.ofArray passing, Seq.ofArray failing) + + let inline accumulate ([] project: 'T -> Report<'Pass, IFault>) (items: 'T seq) : Report<'Pass seq, CompoundFault> = + items |> Seq.toArray |> Array.accumulate project |> Report.map Array.toSeq + + let inline traverse ([] project: 'T -> Report<'Pass, IFault>) (items: 'T seq) : Report<'Pass seq, IFault> = + items |> Seq.toArray |> Array.traverse project |> Report.map Array.toSeq + + let inline sequence (reports: Report<'Pass, IFault> seq) : Report<'Pass seq, IFault> = reports |> traverse id + + + +type ReportBuilder() = + + member _.Return v = Pass v + + member inline _.ReturnFrom(v: Report<_, _>) = v + + member inline _.ReturnFrom(exn: exn) = Report.ofExn exn + + member inline _.Bind(report, [] f) = Report.bind f report + + + +// type AsyncReportBuilder() = + +// member _.Return v = async.Return(Pass v) + +// member inline _.ReturnFrom(v: Async>) = v + +// member inline _.Bind(report, [] f) = async { +// let! report = report +// match report with +// | Pass value -> return! f value +// | Fail error -> return Fail error +// } + + + +// type ILogError = +// abstract LogIt: Logger<_> -> unit + + +[] +module ReportBuilderExtensions = + + let report = ReportBuilder() + +module Example = + + type WorkFailed = + | Timeout + | NetworkError + | UnknownError + + interface IFault with + member this.Cause: IFault option = None + + member this.Message: string = + match this with + | Timeout -> "The operation timed out." + | NetworkError -> "A network error occurred." + | UnknownError -> "An unknown error occurred." + // interface ILogError with + // member this.LogIt logger = + // match this with + // | Timeout -> logger.LogError("Timeout") + // | NetworkError -> logger.LogError("NetworkError") + // | UnknownError -> logger.LogError("UnknownError") + + [] + let inline (|FailAsWorkFailed|_|) x = + match x with + | FailAs(fault: WorkFailed) -> ValueSome fault + | _ -> ValueNone + + let doWork (magicFail: int) = + report { + if magicFail = 42 then + return! Fail WorkFailed.Timeout + else + return "lol" + } + + type OtherWorkFailed = + | CatNeedsPetting + | CatNeedsFed + | CatInLap + + interface IFault with + member this.Cause: IFault option = None + + member this.Message: string = + match this with + | CatNeedsPetting -> "The cat needs petting." + | CatNeedsFed -> "The cat needs fed." + | CatInLap -> "The cat is in your lap. You cannot move" + + let doWork2 magicFail = + report { + if magicFail = 1701 then + return! Fail OtherWorkFailed.CatInLap + else + return "lmao" + } + + let doSomethingStupid (divisor) = + try + 1 / divisor |> Pass + with e -> + Report.ofExn e + + let doWorkAgain () = + report { + let! x = doWork 43 |> Report.generalize + let! y = doWork2 1702 |> Report.generalize + let! z = doSomethingStupid 0 |> Report.generalize + return x, y, z + } + + let handler () = + match doWorkAgain () with + | Pass(x) -> printfn "Success: %A" x + | FailAsWorkFailed(fault) -> + match fault with + | WorkFailed.NetworkError -> printfn "Network Error" + | WorkFailed.Timeout -> printfn "Timeout" + | WorkFailed.UnknownError -> printfn "Unknown Error" + | Demoted(f: System.DivideByZeroException) -> eprintfn "%A" f + | Fail error -> printfn "Error: %s" error.Message + +open Example + +handler () + + + +let doException () = + let doWork () = raise (new System.Exception("This is an exception")) + + let thrown () = + printfn "---Doing Thrown ---" + let mutable original = null + let mutable dispatchInfo = null + + try + try + doWork () + with e -> + original <- e + dispatchInfo <- ExceptionDispatchInfo.Capture(e) + raise e + with e -> + printfn "Original Exception: %A" original + printfn "Thrown: %A" e + + try + dispatchInfo.Throw() + with e -> + printfn "Dispatched Exception: %A" e + + printfn "---Done Thrown ---" + + thrown () + + let doingReraise () = + printfn "---Doing doingReraise ---" + let mutable original = null + let mutable dispatchInfo = null + + try + try + doWork () + with e -> + original <- e + dispatchInfo <- ExceptionDispatchInfo.Capture(e) + reraise () + with e -> + printfn "Original Exception: %A" original + printfn "Thrown: %A" e + + try + dispatchInfo.Throw() + with e -> + printfn "Dispatched Exception: %A" e + + printfn "---Done doingReraise ---" + + let doingInner () = + printfn "---Doing doingInner ---" + let mutable original = null + // let mutable dispatchInfo = null + try + try + doWork () + with e -> + original <- e + // dispatchInfo <- ExceptionDispatchInfo.Capture(e) + reraise () + with e -> + printfn "Original Exception: %A" original + printfn "Thrown: %A" e + + try + raise (new System.Exception("This is an outer exception", original)) + with e -> + printfn "Dispatched Exception: %A" e + + printfn "---Done doingInner ---" + + thrown () + doingReraise () + doingInner () + +doException () diff --git a/src/FsAutoComplete.Core/AbstractClassStubGenerator.fs b/src/FsAutoComplete.Core/AbstractClassStubGenerator.fs index 9458913f5..b2b8ab12a 100644 --- a/src/FsAutoComplete.Core/AbstractClassStubGenerator.fs +++ b/src/FsAutoComplete.Core/AbstractClassStubGenerator.fs @@ -57,7 +57,7 @@ let tryFindAbstractClassExprInBufferAtPos let! inheritType, inheritMemberRange = // this must exist for abstract types allMembers |> List.tryPick (function - | SynMemberDefn.ImplicitInherit(inheritType, _, _, range) -> Some(inheritType, range) + | SynMemberDefn.ImplicitInherit(inheritType, _, _, range, _) -> Some(inheritType, range) | _ -> None) let furthestMemberToSkip, otherMembers = diff --git a/src/FsAutoComplete.Core/AdaptiveExtensions.fs b/src/FsAutoComplete.Core/AdaptiveExtensions.fs index adb4dddf3..2829c7123 100644 --- a/src/FsAutoComplete.Core/AdaptiveExtensions.fs +++ b/src/FsAutoComplete.Core/AdaptiveExtensions.fs @@ -44,7 +44,7 @@ module AdaptiveExtensions = match task.Status with | TaskStatus.RanToCompletion -> tcs.TrySetResult task.Result |> ignore | TaskStatus.Canceled -> - tcs.TrySetCanceled(TaskCanceledException(task).CancellationToken) + tcs.TrySetException(TaskCanceledException(task)) |> ignore | TaskStatus.Faulted -> tcs.TrySetException(task.Exception.InnerExceptions) @@ -118,6 +118,63 @@ type MapDisposableTupleVal<'T1, 'T2, 'Disposable when 'Disposable :> IDisposable b module AVal = + + // [] + // type MapByVal<'T1, 'T2>(equals, mapping: 'T1 -> 'T2, input: aval<'T1>) = + // inherit AbstractVal<'T2>() + + // // can we avoid double caching (here and in AbstractVal) + // let mutable cache: ValueOption = ValueNone + + // override x.Compute(token: AdaptiveToken) = + // let i = input.GetValue token + // match cache with + // | ValueSome (struct (a, b)) when equals a i -> + // b + // | _ -> + // let b = mapping i + // cache <- ValueSome(struct (i, b)) + // b + + + // /// Aval for binding a single value + // [] + // type BindByVal<'T1, 'T2>(equals, mapping: 'T1 -> aval<'T2>, input: aval<'T1>) = + // inherit AbstractVal<'T2>() + + // let mutable inner: ValueOption< struct ('T1 * aval<'T2>) > = ValueNone + // let mutable inputDirty = 1 + + // override x.InputChangedObject(_, o) = + // if Object.ReferenceEquals(o, input) then + // inputDirty <- 1 + + // override x.Compute(token: AdaptiveToken) = + // let va = input.GetValue token + // #if FABLE_COMPILER + // let inputDirty = let v = inputDirty in inputDirty <- 0; v <> 0 + // #else + // let inputDirty = System.Threading.Interlocked.Exchange(&inputDirty, 0) <> 0 + // #endif + // match inner with + // | ValueNone -> + // let result = mapping va + // inner <- ValueSome (struct (va, result)) + // result.GetValue token + + // | ValueSome(struct (oa, oldResult)) when not inputDirty || equals oa va -> + // oldResult.GetValue token + + // | ValueSome(struct (_, old)) -> + // old.Outputs.Remove x |> ignore + // let result = mapping va + // inner <- ValueSome (struct (va, result)) + // result.GetValue token + + // let mapBy equals mapping input = MapByVal(equals, mapping, input) :> aval<_> + + // let bindBy equals mapping input = BindByVal(equals, mapping, input) :> aval<_> + let mapOption f = AVal.map (Option.map f) /// @@ -412,12 +469,14 @@ and AdaptiveCancellableTask<'a>(cancel: unit -> unit, real: Task<'a>) = let mutable cachedTcs: TaskCompletionSource<'a> = null let mutable cached: Task<'a> = null + + let getTask () = let createCached () = if real.IsCompleted then real else - cachedTcs <- new TaskCompletionSource<'a>() + cachedTcs <- new TaskCompletionSource<'a>(TaskCreationOptions.RunContinuationsAsynchronously) cachedTcs.TrySetFromTaskFinished real @@ -699,7 +758,7 @@ module AsyncAVal = /// adaptive inputs. /// let mapSync (mapping: 'a -> CancellationToken -> 'b) (input: asyncaval<'a>) = - map (fun a ct -> Task.Run(fun () -> mapping a ct)) input + map (fun a ct -> Task.Run((fun () -> mapping a ct), ct)) input /// /// Returns a new async adaptive value that adaptively applies the mapping function to the given diff --git a/src/FsAutoComplete.Core/Commands.fs b/src/FsAutoComplete.Core/Commands.fs index 2a100f08e..211eb755b 100644 --- a/src/FsAutoComplete.Core/Commands.fs +++ b/src/FsAutoComplete.Core/Commands.fs @@ -946,9 +946,8 @@ module Commands = let multipleSymbols = tyRes.TryGetSymbolUses pos lineStr let result = Dictionary, Range[]>() - for symbolUse in multipleSymbols do - let! symbolResult = - symbolUseWorkspaceAux + let getUse = + symbolUseWorkspaceAux getDeclarationLocation findReferencesForSymbolInFile tryGetFileSource @@ -959,8 +958,14 @@ module Commands = errorOnFailureToFixRange text tyRes - symbolUse + let! symbolResults = + multipleSymbols + |> List.map getUse + |> Async.parallel75 + |> Async.map(Seq.sequenceResultM) + + for symbolResult in symbolResults do for KeyValue(k, v) in snd symbolResult do if result.ContainsKey k then result.[k] <- [| yield! result.[k]; yield! v |] diff --git a/src/FsAutoComplete.Core/CompilerServiceInterface.fs b/src/FsAutoComplete.Core/CompilerServiceInterface.fs index 1c8cc9000..a91a2ce66 100644 --- a/src/FsAutoComplete.Core/CompilerServiceInterface.fs +++ b/src/FsAutoComplete.Core/CompilerServiceInterface.fs @@ -81,19 +81,24 @@ type CompilerProjectOption = type FSharpCompilerServiceChecker(hasAnalyzers, typecheckCacheSize, parallelReferenceResolution, useTransparentCompiler) = let checker = - FSharpChecker.Create( - projectCacheSize = 200, - keepAssemblyContents = hasAnalyzers, - keepAllBackgroundResolutions = true, - suggestNamesForErrors = true, - keepAllBackgroundSymbolUses = true, - enableBackgroundItemKeyStoreAndSemanticClassification = true, - enablePartialTypeChecking = not hasAnalyzers, - parallelReferenceResolution = parallelReferenceResolution, - captureIdentifiersWhenParsing = true, - useSyntaxTreeCache = true, - useTransparentCompiler = useTransparentCompiler - ) + let c = + FSharpChecker.Create( + projectCacheSize = 200, + keepAssemblyContents = hasAnalyzers, + keepAllBackgroundResolutions = true, + suggestNamesForErrors = true, + keepAllBackgroundSymbolUses = true, + enableBackgroundItemKeyStoreAndSemanticClassification = true, + enablePartialTypeChecking = not hasAnalyzers, + parallelReferenceResolution = parallelReferenceResolution, + captureIdentifiersWhenParsing = true, + useTransparentCompiler = useTransparentCompiler + ) + + if useTransparentCompiler then + c.TransparentCompiler.SetCacheSizeFactor(10) + + c let entityCache = EntityCache() @@ -324,14 +329,12 @@ type FSharpCompilerServiceChecker(hasAnalyzers, typecheckCacheSize, parallelRefe member self.GetProjectSnapshotsFromScript(file: string, source, tfm: FSIRefs.TFM) = async { - try - do! scriptLocker.WaitAsync() |> Async.AwaitTask + use! _l = scriptLocker.LockAsync() match tfm with | FSIRefs.TFM.NetFx -> return! self.GetNetFxScriptSnapshot(file, source) | FSIRefs.TFM.NetCore -> return! self.GetNetCoreScriptSnapshot(file, source) - finally - scriptLocker.Release() |> ignore + } @@ -405,14 +408,11 @@ type FSharpCompilerServiceChecker(hasAnalyzers, typecheckCacheSize, parallelRefe member self.GetProjectOptionsFromScript(file: string, source, tfm) = async { - try - do! scriptLocker.WaitAsync() |> Async.AwaitTask + use! _l = scriptLocker.LockAsync() match tfm with | FSIRefs.TFM.NetFx -> return! self.GetNetFxScriptOptions(file, source) | FSIRefs.TFM.NetCore -> return! self.GetNetCoreScriptOptions(file, source) - finally - scriptLocker.Release() |> ignore } @@ -504,7 +504,9 @@ type FSharpCompilerServiceChecker(hasAnalyzers, typecheckCacheSize, parallelRefe .SetSize(1) .SetSlidingExpiration(TimeSpan.FromMinutes(5.)) - return lastCheckResults.Set(filePath, r, ops) + let rw = WeakReference(r) + lastCheckResults.Set(filePath, rw, ops) |> ignore + return r else return r with ex -> @@ -582,8 +584,11 @@ type FSharpCompilerServiceChecker(hasAnalyzers, typecheckCacheSize, parallelRefe checkerLogger.info (Log.setMessage "{opName}" >> Log.addContextDestructured "opName" opName) - match lastCheckResults.TryGetValue(file) with - | (true, v) -> Some v + match lastCheckResults.TryGetValue>(file) with + | (true, v) -> + match v.TryGetTarget() with + | (true, v) -> Some v + | _ -> None | _ -> None member _.TryGetRecentCheckResultsForFile(file: string, snapshot: FSharpProjectSnapshot) = diff --git a/src/FsAutoComplete.Core/FCSPatches.fs b/src/FsAutoComplete.Core/FCSPatches.fs index 91ccb15d5..60ea2833d 100644 --- a/src/FsAutoComplete.Core/FCSPatches.fs +++ b/src/FsAutoComplete.Core/FCSPatches.fs @@ -85,9 +85,9 @@ module SyntaxTreeOps = | SynExpr.InferredDowncast(e, _) | SynExpr.Lazy(e, _) | SynExpr.TraitCall(_, _, e, _) - | SynExpr.YieldOrReturn(_, e, _) - | SynExpr.YieldOrReturnFrom(_, e, _) - | SynExpr.DoBang(e, _) + | SynExpr.YieldOrReturn(_, e, _, _) + | SynExpr.YieldOrReturnFrom(_, e, _, _) + | SynExpr.DoBang(e, _, _) | SynExpr.Fixed(e, _) | SynExpr.Paren(e, _, _, _) | SynExpr.DotLambda(expr = e) -> walkExpr e diff --git a/src/FsAutoComplete.Core/FileSystem.fs b/src/FsAutoComplete.Core/FileSystem.fs index 54ae88996..f68170fba 100644 --- a/src/FsAutoComplete.Core/FileSystem.fs +++ b/src/FsAutoComplete.Core/FileSystem.fs @@ -140,7 +140,7 @@ type IFSACSourceText = /// Intended use is for traversal loops. abstract member TryGetPrevChar: position: Position -> option /// create a new IFSACSourceText for this file with the given text inserted at the given range. - abstract member ModifyText: range: Range * text: string -> Result + abstract member ModifyText: range: Range * text: string -> IFSACSourceText /// Safe access to the char in a file by Position abstract Item: index: Position -> option with get /// Safe access to the contents of a file by Range @@ -337,10 +337,10 @@ module RoslynSourceText = return np, (x :> IFSACSourceText).GetCharUnsafe np } - member x.ModifyText(range: Range, text: string) : Result = + member x.ModifyText(range: Range, text: string) : IFSACSourceText = let span = range.ToRoslynTextSpan(sourceText) let change = TextChange(span, text) - Ok(RoslynSourceTextFile(fileName, sourceText.WithChanges(change))) + RoslynSourceTextFile(fileName, sourceText.WithChanges(change)) interface ISourceText with diff --git a/src/FsAutoComplete.Core/FileSystem.fsi b/src/FsAutoComplete.Core/FileSystem.fsi index 6fe817e17..1eb73fd4f 100644 --- a/src/FsAutoComplete.Core/FileSystem.fsi +++ b/src/FsAutoComplete.Core/FileSystem.fsi @@ -84,7 +84,7 @@ type IFSACSourceText = /// Intended use is for traversal loops. abstract member TryGetPrevChar: position: Position -> option /// create a new IFSACSourceText for this file with the given text inserted at the given range. - abstract member ModifyText: range: Range * text: string -> Result + abstract member ModifyText: range: Range * text: string -> IFSACSourceText /// Safe access to the char in a file by Position abstract Item: index: Position -> option with get /// Safe access to the contents of a file by Range diff --git a/src/FsAutoComplete.Core/FsAutoComplete.Core.fsproj b/src/FsAutoComplete.Core/FsAutoComplete.Core.fsproj index 04812cf9f..576371ab5 100644 --- a/src/FsAutoComplete.Core/FsAutoComplete.Core.fsproj +++ b/src/FsAutoComplete.Core/FsAutoComplete.Core.fsproj @@ -2,10 +2,14 @@ net8.0 net8.0;net9.0 + net9.0 + $(TargetFrameworks);net9.0 false $(NoWarn);FS0057 + + diff --git a/src/FsAutoComplete.Core/SemaphoreSlimLocks.fs b/src/FsAutoComplete.Core/SemaphoreSlimLocks.fs index b59dd0007..0b7f10965 100644 --- a/src/FsAutoComplete.Core/SemaphoreSlimLocks.fs +++ b/src/FsAutoComplete.Core/SemaphoreSlimLocks.fs @@ -16,12 +16,12 @@ type AwaitableDisposable<'T when 'T :> IDisposable>(t: Task<'T>) = [] module SemaphoreSlimExtensions = open System.Threading + open IcedTasks // Based on https://gist.github.com/StephenCleary/7dd1c0fc2a6594ba0ed7fb7ad6b590d6 // and https://gist.github.com/brendankowitz/5949970076952746a083054559377e56 type SemaphoreSlim with - member x.LockAsync(?ct: CancellationToken) = - AwaitableDisposable( + member x.LockTask(?ct: CancellationToken) = task { let ct = defaultArg ct CancellationToken.None let t = x.WaitAsync(ct) @@ -36,4 +36,9 @@ module SemaphoreSlimExtensions = if t.Status = TaskStatus.RanToCompletion then x.Release() |> ignore } } - ) + + member x.LockAsync() = + asyncEx { + let! ct = Async.CancellationToken + return! x.LockTask ct + } diff --git a/src/FsAutoComplete.Core/SemaphoreSlimLocks.fsi b/src/FsAutoComplete.Core/SemaphoreSlimLocks.fsi index 358ac356c..de3a1b054 100644 --- a/src/FsAutoComplete.Core/SemaphoreSlimLocks.fsi +++ b/src/FsAutoComplete.Core/SemaphoreSlimLocks.fsi @@ -3,16 +3,16 @@ namespace FsAutoComplete open System open System.Threading.Tasks -/// -/// An awaitable wrapper around a task whose result is disposable. The wrapper is not disposable, so this prevents usage errors like "use _lock = myAsync()" when the appropriate usage should be "use! _lock = myAsync())". -/// -[] -[] -type AwaitableDisposable<'T when 'T :> IDisposable> = - new: t: Task<'T> -> AwaitableDisposable<'T> - member GetAwaiter: unit -> Runtime.CompilerServices.TaskAwaiter<'T> - member AsTask: unit -> Task<'T> - static member op_Implicit: source: AwaitableDisposable<'T> -> Task<'T> +// /// +// /// An awaitable wrapper around a task whose result is disposable. The wrapper is not disposable, so this prevents usage errors like "use _lock = myAsync()" when the appropriate usage should be "use! _lock = myAsync())". +// /// +// [] +// [] +// type AwaitableDisposable<'T when 'T :> IDisposable> = +// new: t: Task<'T> -> AwaitableDisposable<'T> +// member GetAwaiter: unit -> Runtime.CompilerServices.TaskAwaiter<'T> +// member AsTask: unit -> Task<'T> +// static member op_Implicit: source: AwaitableDisposable<'T> -> Task<'T> [] module SemaphoreSlimExtensions = @@ -20,4 +20,5 @@ module SemaphoreSlimExtensions = type SemaphoreSlim with - member LockAsync: ?ct: CancellationToken -> AwaitableDisposable + member LockTask: ?ct: CancellationToken -> Task + member LockAsync: unit -> Async diff --git a/src/FsAutoComplete.Core/TestAdapter.fs b/src/FsAutoComplete.Core/TestAdapter.fs index 2f589caf6..b64ba8cca 100644 --- a/src/FsAutoComplete.Core/TestAdapter.fs +++ b/src/FsAutoComplete.Core/TestAdapter.fs @@ -182,14 +182,14 @@ let getExpectoTests (ast: ParsedInput) : TestAdapterEntry list = | SynExpr.ArrayOrListComputed(_, expr, _) | SynExpr.ComputationExpr(expr = expr) | SynExpr.Lambda(body = expr) - | SynExpr.YieldOrReturn(_, expr, _) - | SynExpr.YieldOrReturnFrom(_, expr, _) + | SynExpr.YieldOrReturn(_, expr, _, _) + | SynExpr.YieldOrReturnFrom(_, expr, _, _) | SynExpr.New(_, _, expr, _) | SynExpr.Assert(expr, _) | SynExpr.Do(expr, _) | SynExpr.Typed(expr, _, _) | SynExpr.Paren(expr, _, _, _) - | SynExpr.DoBang(expr, _) + | SynExpr.DoBang(expr, _, _) | SynExpr.Downcast(expr, _, _) | SynExpr.For(doBody = expr) | SynExpr.Lazy(expr, _) diff --git a/src/FsAutoComplete.Core/UnionPatternMatchCaseGenerator.fs b/src/FsAutoComplete.Core/UnionPatternMatchCaseGenerator.fs index e822d8a3b..abc667bc0 100644 --- a/src/FsAutoComplete.Core/UnionPatternMatchCaseGenerator.fs +++ b/src/FsAutoComplete.Core/UnionPatternMatchCaseGenerator.fs @@ -276,9 +276,9 @@ let private tryFindPatternMatchExprInParsedInput (pos: Position) (parsedInput: P | SynExpr.Null(_range) | SynExpr.ImplicitZero(_range) -> None - | SynExpr.YieldOrReturn(_, synExpr, _range) - | SynExpr.YieldOrReturnFrom(_, synExpr, _range) - | SynExpr.DoBang(synExpr, _range) -> walkExpr synExpr + | SynExpr.YieldOrReturn(_, synExpr, _range, _) + | SynExpr.YieldOrReturnFrom(_, synExpr, _range, _) + | SynExpr.DoBang(synExpr, _range, _) -> walkExpr synExpr | SynExpr.LetOrUseBang(rhs = synExpr1; andBangs = ands; body = synExpr2) -> [ synExpr1 diff --git a/src/FsAutoComplete.Core/UntypedAstUtils.fs b/src/FsAutoComplete.Core/UntypedAstUtils.fs index 80f4de8d8..041d34b2d 100644 --- a/src/FsAutoComplete.Core/UntypedAstUtils.fs +++ b/src/FsAutoComplete.Core/UntypedAstUtils.fs @@ -451,14 +451,14 @@ module Syntax = | SynMemberDefn.ImplicitCtor(attributes = AllAttrs attrs; ctorArgs = ctorPattern) -> List.iter walkAttribute attrs walkPat ctorPattern - | SynMemberDefn.ImplicitInherit(t, e, _, _) -> + | SynMemberDefn.ImplicitInherit(t, e, _, _, _) -> walkType t walkExpr e | SynMemberDefn.LetBindings(bindings, _, _, _) -> List.iter walkBinding bindings | SynMemberDefn.Interface(t, _, members, _) -> walkType t members |> Option.iter (List.iter walkMember) - | SynMemberDefn.Inherit(t, _, _) -> walkType t + | SynMemberDefn.Inherit(t, _, _, _) -> t |> Option.iter walkType | SynMemberDefn.ValField(field, _) -> walkField field | SynMemberDefn.NestedType(tdef, _, _) -> walkTypeDefn tdef | SynMemberDefn.AutoProperty(attributes = AllAttrs attrs; typeOpt = t; synExpr = e; range = _) -> diff --git a/src/FsAutoComplete.Core/Utils.fs b/src/FsAutoComplete.Core/Utils.fs index 3d4065c6e..22cdf57e3 100644 --- a/src/FsAutoComplete.Core/Utils.fs +++ b/src/FsAutoComplete.Core/Utils.fs @@ -70,7 +70,7 @@ module ProcessHelper = let WaitForExitAsync (p: Process) = asyncEx { - let tcs = TaskCompletionSource() + let tcs = TaskCompletionSource(TaskCreationOptions.RunContinuationsAsynchronously) p.EnableRaisingEvents <- true p.Exited.Add(fun _args -> tcs.TrySetResult(null) |> ignore) @@ -239,10 +239,11 @@ module Async = /// Creates an asynchronous computation that executes all the given asynchronous computations, using 75% of the Environment.ProcessorCount /// A sequence of distinct computations to be parallelized. let parallel75 computations = - let maxConcurrency = - Math.Max(1.0, Math.Floor((float System.Environment.ProcessorCount) * 0.75)) + // let maxConcurrency = + // Math.Max(1.0, Math.Floor((float System.Environment.ProcessorCount) * 0.75)) - Async.Parallel(computations, int maxConcurrency) + // Async.Parallel(computations, int maxConcurrency) + Async.Parallel computations [] module Array = diff --git a/src/FsAutoComplete/FsAutoComplete.fsproj b/src/FsAutoComplete/FsAutoComplete.fsproj index d50fd1309..16e78a007 100644 --- a/src/FsAutoComplete/FsAutoComplete.fsproj +++ b/src/FsAutoComplete/FsAutoComplete.fsproj @@ -4,6 +4,8 @@ Exe net8.0 net8.0;net9.0 + net9.0 + $(TargetFrameworks);net9.0 fsautocomplete true true @@ -48,6 +50,8 @@ + + diff --git a/src/FsAutoComplete/LspHelpers.fs b/src/FsAutoComplete/LspHelpers.fs index 717a4ae8b..8e5c70e77 100644 --- a/src/FsAutoComplete/LspHelpers.fs +++ b/src/FsAutoComplete/LspHelpers.fs @@ -86,11 +86,7 @@ module Conversions = | Some(U2.C2 code) -> code |> Some | None -> None - type TextDocumentIdentifier with - - member doc.GetFilePath() = Path.FileUriToLocalPath doc.Uri - - type VersionedTextDocumentIdentifier with + type ITextDocumentIdentifier with member doc.GetFilePath() = Path.FileUriToLocalPath doc.Uri diff --git a/src/FsAutoComplete/LspHelpers.fsi b/src/FsAutoComplete/LspHelpers.fsi index 25b0ce2e2..20d90ee62 100644 --- a/src/FsAutoComplete/LspHelpers.fsi +++ b/src/FsAutoComplete/LspHelpers.fsi @@ -46,11 +46,7 @@ module Conversions = member CodeAsString: string option - type TextDocumentIdentifier with - - member GetFilePath: unit -> string - - type VersionedTextDocumentIdentifier with + type ITextDocumentIdentifier with member GetFilePath: unit -> string diff --git a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs index e7a969290..cfe1ba826 100644 --- a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs +++ b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs @@ -79,7 +79,7 @@ type AdaptiveFSharpLspServer | :? TaskCanceledException -> ValueSome(e) | :? OperationCanceledException -> ValueSome(e) | :? System.AggregateException as aex -> - if aex.InnerExceptions.Count = 1 then + if aex.Flatten().InnerExceptions.Count = 1 then (|Cancelled|_|) aex.InnerException else ValueNone @@ -944,7 +944,7 @@ type AdaptiveFSharpLspServer let (filePath, pos) = getFilePathAndPosition p let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr let! lineStr = volatileFile.Source |> tryGetLineStr pos |> Result.lineLookupErr - and! tyRes = state.GetOpenFileTypeCheckResultsCached filePath |> AsyncResult.ofStringErr + and! tyRes = state.GetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr match tyRes.TryGetToolTipEnhanced pos lineStr with | Some tooltipResult -> @@ -1587,7 +1587,7 @@ type AdaptiveFSharpLspServer let filePath = Path.FileUriToLocalPath data.[0] |> Utils.normalizePath try - let! tyRes = state.GetOpenFileTypeCheckResultsCached filePath |> AsyncResult.ofStringErr + let! tyRes = state.GetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr logger.info ( @@ -2201,9 +2201,7 @@ type AdaptiveFSharpLspServer ) let (filePath, pos) = - { new ITextDocumentPositionParams with - member __.TextDocument = p.TextDocument - member __.Position = p.Position } + p |> getFilePathAndPosition let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr diff --git a/src/FsAutoComplete/LspServers/AdaptiveServerState.fs b/src/FsAutoComplete/LspServers/AdaptiveServerState.fs index ebb226282..833a77f6e 100644 --- a/src/FsAutoComplete/LspServers/AdaptiveServerState.fs +++ b/src/FsAutoComplete/LspServers/AdaptiveServerState.fs @@ -326,13 +326,13 @@ type AdaptiveState FSIRefs.TFM.NetFx) - let sendDiagnostics (uri: DocumentUri) (diags: Diagnostic[]) = + let sendDiagnostics (uri: DocumentUri) (version, diags: Diagnostic[]) = logger.info (Log.setMessageI $"SendDiag for {uri:file}: {diags.Length:diags} entries") // TODO: providing version would be very useful { Uri = uri Diagnostics = diags - Version = None } + Version = version } |> lspClient.TextDocumentPublishDiagnostics @@ -377,6 +377,13 @@ type AdaptiveState disposables.Add <| fileParsed.Publish.Subscribe(fun (parseResults, proj, ct) -> detectTests parseResults proj ct) + let analyzersLocker = new SemaphoreSlim(1,1) + + let typecheckLocker = + let maxConcurrency = + Math.Max(1.0, Math.Floor((float System.Environment.ProcessorCount) * 0.75)) |> int + new SemaphoreSlim(maxConcurrency,maxConcurrency) + let builtInCompilerAnalyzers config (file: VolatileFile) (tyRes: ParseAndCheckResults) = let filePath = file.FileName let filePathUntag = UMX.untag filePath @@ -387,9 +394,12 @@ type AdaptiveState let inline getSourceLine lineNo = (source: ISourceText).GetLineString(lineNo - 1) + let checkUnusedOpens = asyncEx { try + let! ct = Async.CancellationToken + use! _l = analyzersLocker.LockAsync() use progress = progressLookup.CreateProgressReport(lspClient, cancellable = true) do! progress.Begin($"Checking unused opens {fileName}...", message = filePathUntag) @@ -397,7 +407,6 @@ type AdaptiveState UnusedOpens.getUnusedOpens (tyRes.GetCheckResults, getSourceLine) |> Async.withCancellation progress.CancellationToken - let! ct = Async.CancellationToken notifications.Trigger(NotificationEvent.UnusedOpens(filePath, (unused |> List.toArray), file.Version), ct) with e -> logger.error (Log.setMessage "checkUnusedOpens failed" >> Log.addExn e) @@ -406,6 +415,8 @@ type AdaptiveState let checkUnusedDeclarations = asyncEx { try + let! ct = Async.CancellationToken + use! _l = analyzersLocker.LockAsync() use progress = progressLookup.CreateProgressReport(lspClient, cancellable = true) do! progress.Begin($"Checking unused declarations {fileName}...", message = filePathUntag) @@ -417,7 +428,6 @@ type AdaptiveState let unused = unused |> Seq.toArray - let! ct = Async.CancellationToken notifications.Trigger(NotificationEvent.UnusedDeclarations(filePath, unused, file.Version), ct) with e -> logger.error (Log.setMessage "checkUnusedDeclarations failed" >> Log.addExn e) @@ -426,6 +436,8 @@ type AdaptiveState let checkSimplifiedNames = asyncEx { try + let! ct = Async.CancellationToken + use! _l = analyzersLocker.LockAsync() use progress = progressLookup.CreateProgressReport(lspClient, cancellable = true) do! progress.Begin($"Checking simplifying of names {fileName}...", message = filePathUntag) @@ -434,7 +446,6 @@ type AdaptiveState |> Async.withCancellation progress.CancellationToken let simplified = Array.ofSeq simplified - let! ct = Async.CancellationToken notifications.Trigger(NotificationEvent.SimplifyNames(filePath, simplified, file.Version), ct) with e -> logger.error (Log.setMessage "checkSimplifiedNames failed" >> Log.addExn e) @@ -443,6 +454,8 @@ type AdaptiveState let checkUnnecessaryParentheses = asyncEx { try + let! ct = Async.CancellationToken + use! _l = analyzersLocker.LockAsync() use progress = progressLookup.CreateProgressReport(lspClient) do! progress.Begin($"Checking for unnecessary parentheses {fileName}...", message = filePathUntag) @@ -464,7 +477,6 @@ type AdaptiveState | _ -> ranges) - let! ct = Async.CancellationToken notifications.Trigger( NotificationEvent.UnnecessaryParentheses(filePath, Array.ofSeq unnecessaryParentheses, file.Version), @@ -513,6 +525,9 @@ type AdaptiveState let file = volatileFile.FileName try + + let! ct = Async.CancellationToken + use! _l = analyzersLocker.LockAsync() use progress = new ServerProgressReport(lspClient) do! progress.Begin("Running analyzers...", message = UMX.untag file) @@ -536,7 +551,6 @@ type AdaptiveState parseAndCheck.GetCheckResults ) - let! ct = Async.CancellationToken notifications.Trigger(NotificationEvent.AnalyzerMessage(res, file, volatileFile.Version), ct) Loggers.analyzers.info (Log.setMessageI $"end analysis of {file:file}") @@ -908,7 +922,7 @@ type AdaptiveState use progressReport = new ServerProgressReport(lspClient) progressReport.Begin ($"Loading {projects.Count} Projects") (CancellationToken.None) - |> ignore> + |> ignore> let projectOptions = loader.LoadProjects(projects |> Seq.map (fst >> UMX.untag) |> Seq.toList, [], binlogConfig) @@ -1041,21 +1055,8 @@ type AdaptiveState let fcsRangeToReplace = protocolRangeToRange (UMX.untag filePath) change.Range try - match text.Source.ModifyText(fcsRangeToReplace, change.Text) with - | Ok text -> VolatileFile.Create(text, version, touched) - - | Error message -> - logger.error ( - Log.setMessage - "Error applying {change} to document {file} for version {version} - {range} : {message} " - >> Log.addContextDestructured "file" filePath - >> Log.addContextDestructured "version" version - >> Log.addContextDestructured "message" message - >> Log.addContextDestructured "range" fcsRangeToReplace - >> Log.addContextDestructured "change" change - ) - - text + let text = text.Source.ModifyText(fcsRangeToReplace, change.Text) + VolatileFile.Create(text, version, touched) with e -> logger.error ( Log.setMessage "Error applying {change} to document {file} for version {version} - {range}" @@ -1186,24 +1187,18 @@ type AdaptiveState } let cancelToken filePath version (cts: CancellationTokenSource) = + logger.info ( + Log.setMessage "Cancelling {filePath} - {version}" + >> Log.addContextDestructured "filePath" filePath + >> Log.addContextDestructured "version" version + ) + cts.TryCancel() + cts.TryDispose() - try - logger.info ( - Log.setMessage "Cancelling {filePath} - {version}" - >> Log.addContextDestructured "filePath" filePath - >> Log.addContextDestructured "version" version - ) - - cts.Cancel() - cts.Dispose() - with - | :? OperationCanceledException - | :? ObjectDisposedException as e when e.Message.Contains("CancellationTokenSource has been disposed") -> - // ignore if already cancelled - () let resetCancellationToken (filePath: string) version = - let adder _ = new CancellationTokenSource() + let adder _ = + new CancellationTokenSource() let updater _key value = cancelToken filePath version value @@ -1601,6 +1596,8 @@ type AdaptiveState use _ = fsacActivitySource.StartActivityForType(thisType, tags = tags) + use! _l = typecheckLocker.LockAsync() + logger.info ( Log.setMessage "Getting typecheck results for {file} - {hash} - {date}" @@ -1745,7 +1742,7 @@ type AdaptiveState let! snap = x.FSharpProjectCompilerOptions return! - asyncResult { + asyncEx { let cts = getOpenFileTokenOrDefault file use linkedCts = CancellationTokenSource.CreateLinkedTokenSource(ctok, cts) @@ -2500,11 +2497,7 @@ type AdaptiveState member x.GetTypeCheckResultsForFile(filePath, opts) = bypassAdaptiveTypeCheck filePath opts member x.GetTypeCheckResultsForFile(filePath) = - asyncResult { - let! opts = forceGetProjectOptions filePath - let snap = opts.FSharpProjectCompilerOptions |> AVal.force - return! x.GetTypeCheckResultsForFile(filePath, snap) - } + forceGetOpenFileTypeCheckResultsOrCheck filePath member x.GetFilesToProject() = getAllFilesToProjectOptionsSelected () diff --git a/src/FsAutoComplete/LspServers/Common.fs b/src/FsAutoComplete/LspServers/Common.fs index cc96f3cba..3a4c10792 100644 --- a/src/FsAutoComplete/LspServers/Common.fs +++ b/src/FsAutoComplete/LspServers/Common.fs @@ -55,9 +55,13 @@ type DiagnosticMessage = | Clear of source: string /// a type that handles bookkeeping for sending file diagnostics. It will debounce calls and handle sending diagnostics via the configured function when safe -type DiagnosticCollection(sendDiagnostics: DocumentUri -> Diagnostic[] -> Async) = +type DiagnosticCollection(sendDiagnostics: DocumentUri -> Version option * Diagnostic[] -> Async) = let send uri (diags: Map) = - Map.toArray diags |> Array.collect (snd >> snd) |> sendDiagnostics uri + // Map.toArray diags |> Array.collect (snd >> snd) |> sendDiagnostics uri + if diags.Values |> Seq.isEmpty then + sendDiagnostics uri (None, [||]) + else + diags.Values |> Seq.maxBy(fun (version, _) -> version) |> fun (version, diags) -> sendDiagnostics uri (Some version, diags) let agents = System.Collections.Concurrent.ConcurrentDictionary< @@ -131,10 +135,10 @@ type DiagnosticCollection(sendDiagnostics: DocumentUri -> Diagnostic[] -> Async< | [||] -> mailbox.Post(Clear kind) | values -> mailbox.Post(Add(kind, version, values)) - member x.ClearFor(fileUri: DocumentUri) = + member x.ClearFor(fileUri: DocumentUri, ?version) = if x.ClientSupportsDiagnostics then removeAgent fileUri - sendDiagnostics fileUri [||] |> Async.Start + sendDiagnostics fileUri (version, [||]) |> Async.Start member x.ClearFor(fileUri: DocumentUri, kind: string) = if x.ClientSupportsDiagnostics then @@ -146,6 +150,38 @@ type DiagnosticCollection(sendDiagnostics: DocumentUri -> Diagnostic[] -> Async< for (_, cts) in agents.Values do cts.Cancel() +module CancellableTask = + open IcedTasks + open Microsoft.FSharp.Core.CompilerServices + + let inline startAsTask (ct: CancellationToken) ([] ctask: CancellableTask<'T>) = ctask ct + + let inline fireAndForget (ct: CancellationToken) ([] ctask: CancellableTask<'T>) = + startAsTask ct ctask + |> ignore + + let inline withCancellation (ct: CancellationToken) ([] ctask: CancellableTask<'T>) = + cancellableTask { + let! ct2 = CancellableTask.getCancellationToken () + use cts = CancellationTokenSource.CreateLinkedTokenSource(ct, ct2) + let! result = startAsTask cts.Token ctask + return result + } + + let inline withCancellations (ct: CancellationToken array) ([] ctask: CancellableTask<'T>) = + cancellableTask { + + let! ct2 = CancellableTask.getCancellationToken () + + use cts = + let mutable tokens = ArrayCollector() + tokens.Add ct2 + tokens.AddManyAndClose ct |> CancellationTokenSource.CreateLinkedTokenSource + + let! result = startAsTask cts.Token ctask + return result + } + module Async = open System.Threading.Tasks open IcedTasks @@ -158,7 +194,10 @@ module Async = asyncEx { let! ct2 = Async.CancellationToken use cts = CancellationTokenSource.CreateLinkedTokenSource(ct, ct2) - let tcs = new TaskCompletionSource<'a>() + + let tcs = + new TaskCompletionSource<'a>(TaskCreationOptions.RunContinuationsAsynchronously) + use _reg = cts.Token.Register(fun () -> tcs.TrySetCanceled(cts.Token) |> ignore) let a = diff --git a/src/FsAutoComplete/LspServers/FSharpLspClient.fs b/src/FsAutoComplete/LspServers/FSharpLspClient.fs index 5ab36cd5c..d1561732b 100644 --- a/src/FsAutoComplete/LspServers/FSharpLspClient.fs +++ b/src/FsAutoComplete/LspServers/FSharpLspClient.fs @@ -105,8 +105,8 @@ type ServerProgressReport(lspClient: FSharpLspClient, ?token: ProgressToken, ?ca member x.Begin(title, ?cancellable, ?message, ?percentage) = - cancellableTask { - use! __ = fun (ct: CancellationToken) -> locker.LockAsync(ct) + cancellableValueTask { + use! __ = locker.LockTask if not endSent then let! result = lspClient.WorkDoneProgressCreate x.ProgressToken @@ -129,8 +129,8 @@ type ServerProgressReport(lspClient: FSharpLspClient, ?token: ProgressToken, ?ca } member x.Report(?cancellable, ?message, ?percentage) = - cancellableTask { - use! __ = fun ct -> locker.LockAsync(ct) + cancellableValueTask { + use! __ = locker.LockTask if canReportProgress && not endSent then do! @@ -145,8 +145,8 @@ type ServerProgressReport(lspClient: FSharpLspClient, ?token: ProgressToken, ?ca } member x.End(?message) = - cancellableTask { - use! __ = fun ct -> locker.LockAsync(ct) + cancellableValueTask { + use! __ = locker.LockTask let stillNeedsToSend = canReportProgress && not endSent if stillNeedsToSend then diff --git a/src/FsAutoComplete/LspServers/FSharpLspClient.fsi b/src/FsAutoComplete/LspServers/FSharpLspClient.fsi index 4fbadc76e..9e07a1192 100644 --- a/src/FsAutoComplete/LspServers/FSharpLspClient.fsi +++ b/src/FsAutoComplete/LspServers/FSharpLspClient.fsi @@ -57,19 +57,19 @@ type ServerProgressReport = /// Controls if a cancel button should show to allow the user to cancel the long running operation /// more detailed associated progress message. Contains complementary information to the `title`. /// percentage to display (value 100 is considered 100%). If not provided infinite progress is assumed - member Begin: title: string * ?cancellable: bool * ?message: string * ?percentage: uint -> CancellableTask + member Begin: title: string * ?cancellable: bool * ?message: string * ?percentage: uint -> CancellableValueTask /// Report additional progress /// Controls if a cancel button should show to allow the user to cancel the long running operation /// more detailed associated progress message. Contains complementary information to the `title`. /// percentage to display (value 100 is considered 100%). If not provided infinite progress is assumed - member Report: ?cancellable: bool * ?message: string * ?percentage: uint -> CancellableTask + member Report: ?cancellable: bool * ?message: string * ?percentage: uint -> CancellableValueTask /// Signaling the end of a progress reporting is done. /// more detailed associated progress message. Contains complementary information to the `title`. /// /// This will be called if this object is disposed either via Dispose or DisposeAsync. /// /// - member End: ?message: string -> CancellableTask + member End: ?message: string -> CancellableValueTask interface IAsyncDisposable interface IDisposable diff --git a/test/FsAutoComplete.Tests.Lsp/SnapshotTests.fs b/test/FsAutoComplete.Tests.Lsp/SnapshotTests.fs index 01666332b..9319b6f76 100644 --- a/test/FsAutoComplete.Tests.Lsp/SnapshotTests.fs +++ b/test/FsAutoComplete.Tests.Lsp/SnapshotTests.fs @@ -109,7 +109,7 @@ let awaitOutOfDate (o : amap<_,_>) = // So we need to wait for a change to happen before we continue. task { - let tcs = new TaskCompletionSource() + let tcs = new TaskCompletionSource(TaskCreationOptions.RunContinuationsAsynchronously) use cts = new System.Threading.CancellationTokenSource() cts.CancelAfter(5000) use _ = cts.Token.Register(fun () -> tcs.TrySetCanceled(cts.Token) |> ignore) diff --git a/test/FsAutoComplete.Tests.Lsp/Utils/Server.fs b/test/FsAutoComplete.Tests.Lsp/Utils/Server.fs index 065617682..b506125f8 100644 --- a/test/FsAutoComplete.Tests.Lsp/Utils/Server.fs +++ b/test/FsAutoComplete.Tests.Lsp/Utils/Server.fs @@ -278,8 +278,7 @@ module Document = >> Log.addContext "uri" doc.Uri >> Log.addContext "version" doc.Version ) - - let tcs = TaskCompletionSource<_>() + let tcs = TaskCompletionSource<_>(TaskCreationOptions.RunContinuationsAsynchronously) use _ = doc From f1a23effef8ea88850d182b944712c8dd15d95f3 Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Sat, 7 Dec 2024 12:38:07 -0500 Subject: [PATCH 2/5] commit other things --- src/FsAutoComplete.Core/FsAutoComplete.Core.fsproj | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/FsAutoComplete.Core/FsAutoComplete.Core.fsproj b/src/FsAutoComplete.Core/FsAutoComplete.Core.fsproj index 576371ab5..772f1240e 100644 --- a/src/FsAutoComplete.Core/FsAutoComplete.Core.fsproj +++ b/src/FsAutoComplete.Core/FsAutoComplete.Core.fsproj @@ -9,10 +9,17 @@ - + + + + + + + + From 8854d357414fc9a78d8cbff03b5670a55124bf3e Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Sun, 8 Dec 2024 14:18:01 -0500 Subject: [PATCH 3/5] Transparent compiler fixes --- .vscode/settings.json | 2 -- .../CompilerServiceInterface.fs | 17 +++++++++-------- .../LspServers/ProjectWorkspace.fs | 13 +++++++++++++ 3 files changed, 22 insertions(+), 10 deletions(-) diff --git a/.vscode/settings.json b/.vscode/settings.json index 68066a306..2f9d3073a 100644 --- a/.vscode/settings.json +++ b/.vscode/settings.json @@ -168,6 +168,4 @@ "FSharp.lineLens.enabled": "replaceCodeLens", "FSharp.codeLenses.signature.enabled": false, "FSharp.verboseLogging": true, - "FSharp.fcs.transparentCompiler.enabled": true, - "FSharp.fsac.netCoreDllPath": "C:\\Users\\jimmy\\Repositories\\public\\TheAngryByrd\\FsAutoComplete\\src\\FsAutoComplete\\bin\\Release\\" } diff --git a/src/FsAutoComplete.Core/CompilerServiceInterface.fs b/src/FsAutoComplete.Core/CompilerServiceInterface.fs index a91a2ce66..4e23a9f38 100644 --- a/src/FsAutoComplete.Core/CompilerServiceInterface.fs +++ b/src/FsAutoComplete.Core/CompilerServiceInterface.fs @@ -81,8 +81,12 @@ type CompilerProjectOption = type FSharpCompilerServiceChecker(hasAnalyzers, typecheckCacheSize, parallelReferenceResolution, useTransparentCompiler) = let checker = - let c = - FSharpChecker.Create( + let cacheSize = + if useTransparentCompiler then + TransparentCompiler.CacheSizes.Create(10) |> Some + else + None + FSharp.Compiler.CodeAnalysis.FSharpChecker.Create( projectCacheSize = 200, keepAssemblyContents = hasAnalyzers, keepAllBackgroundResolutions = true, @@ -92,14 +96,10 @@ type FSharpCompilerServiceChecker(hasAnalyzers, typecheckCacheSize, parallelRefe enablePartialTypeChecking = not hasAnalyzers, parallelReferenceResolution = parallelReferenceResolution, captureIdentifiersWhenParsing = true, - useTransparentCompiler = useTransparentCompiler + useTransparentCompiler = useTransparentCompiler, + ?transparentCompilerCacheSizes = cacheSize ) - if useTransparentCompiler then - c.TransparentCompiler.SetCacheSizeFactor(10) - - c - let entityCache = EntityCache() // FCS can't seem to handle parallel project restores for script files @@ -145,6 +145,7 @@ type FSharpCompilerServiceChecker(hasAnalyzers, typecheckCacheSize, parallelRefe FSharpProjectSnapshot.Create( snapshot.ProjectFileName, + snapshot.OutputFileName, snapshot.ProjectId, snapshot.SourceFiles, snapshot.ReferencesOnDisk, diff --git a/src/FsAutoComplete/LspServers/ProjectWorkspace.fs b/src/FsAutoComplete/LspServers/ProjectWorkspace.fs index a8e942e7b..87acea47c 100644 --- a/src/FsAutoComplete/LspServers/ProjectWorkspace.fs +++ b/src/FsAutoComplete/LspServers/ProjectWorkspace.fs @@ -44,6 +44,7 @@ module Snapshots = let makeAdaptiveFCSSnapshot projectFileName + outputFileName projectId sourceFiles referencePaths @@ -59,6 +60,7 @@ module Snapshots = // If any of these change, it will create a new snapshot. // And if any of the snapshots in the referencedProjects change, it will create a new snapshot for them as well. let! projectFileName = projectFileName + and! outputFileName = outputFileName and! projectId = projectId and! sourceFiles = sourceFiles and! referencePaths = referencePaths @@ -81,6 +83,7 @@ module Snapshots = return FSharpProjectSnapshot.Create( projectFileName, + outputFileName, projectId, sourceFiles, referencePaths, @@ -97,6 +100,7 @@ module Snapshots = let makeAdaptiveFCSSnapshot2 projectFileName + outputFileName projectId (sourceFiles: alist>) (referencePaths: aset>) @@ -113,6 +117,7 @@ module Snapshots = makeAdaptiveFCSSnapshot projectFileName + outputFileName projectId (flattenAList sourceFiles) (flattenASet referencePaths) @@ -245,6 +250,13 @@ module Snapshots = ) let projectName = AVal.constant project.ProjectFileName + + let outputFileName = + project.OtherOptions + |> Seq.tryFind (fun (x: string) -> x.StartsWith("-o:")) + |> Option.map (fun x -> x.Substring(3)) + |> AVal.constant + let projectId = AVal.constant project.ProjectId @@ -283,6 +295,7 @@ module Snapshots = makeAdaptiveFCSSnapshot2 projectName projectId + outputFileName sourceFiles referencePaths otherOptions From acc81c5a4c99cf09e5bb078904f6f93569f7e7cf Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Sun, 8 Dec 2024 14:24:56 -0500 Subject: [PATCH 4/5] fix bad rebase --- benchmarks/benchmarks.fsproj | 5 -- global.json | 2 +- src/FsAutoComplete.Core/AdaptiveExtensions.fs | 56 ------------------- .../FsAutoComplete.Core.fsproj | 2 - src/FsAutoComplete/FsAutoComplete.fsproj | 4 -- 5 files changed, 1 insertion(+), 68 deletions(-) diff --git a/benchmarks/benchmarks.fsproj b/benchmarks/benchmarks.fsproj index 3f3603d6a..10ca6a14d 100644 --- a/benchmarks/benchmarks.fsproj +++ b/benchmarks/benchmarks.fsproj @@ -4,11 +4,6 @@ Exe net8.0 net8.0;net9.0 - net8.0;net9.0 - - - net8.0 - $(TargetFrameworks);net9.0 diff --git a/global.json b/global.json index 2bc13e80a..fb0099cb2 100644 --- a/global.json +++ b/global.json @@ -1,6 +1,6 @@ { "sdk": { - "version": "9.0.100", + "version": "8.0.300", "rollForward": "latestMinor" } } diff --git a/src/FsAutoComplete.Core/AdaptiveExtensions.fs b/src/FsAutoComplete.Core/AdaptiveExtensions.fs index 2829c7123..178725737 100644 --- a/src/FsAutoComplete.Core/AdaptiveExtensions.fs +++ b/src/FsAutoComplete.Core/AdaptiveExtensions.fs @@ -119,62 +119,6 @@ type MapDisposableTupleVal<'T1, 'T2, 'Disposable when 'Disposable :> IDisposable module AVal = - // [] - // type MapByVal<'T1, 'T2>(equals, mapping: 'T1 -> 'T2, input: aval<'T1>) = - // inherit AbstractVal<'T2>() - - // // can we avoid double caching (here and in AbstractVal) - // let mutable cache: ValueOption = ValueNone - - // override x.Compute(token: AdaptiveToken) = - // let i = input.GetValue token - // match cache with - // | ValueSome (struct (a, b)) when equals a i -> - // b - // | _ -> - // let b = mapping i - // cache <- ValueSome(struct (i, b)) - // b - - - // /// Aval for binding a single value - // [] - // type BindByVal<'T1, 'T2>(equals, mapping: 'T1 -> aval<'T2>, input: aval<'T1>) = - // inherit AbstractVal<'T2>() - - // let mutable inner: ValueOption< struct ('T1 * aval<'T2>) > = ValueNone - // let mutable inputDirty = 1 - - // override x.InputChangedObject(_, o) = - // if Object.ReferenceEquals(o, input) then - // inputDirty <- 1 - - // override x.Compute(token: AdaptiveToken) = - // let va = input.GetValue token - // #if FABLE_COMPILER - // let inputDirty = let v = inputDirty in inputDirty <- 0; v <> 0 - // #else - // let inputDirty = System.Threading.Interlocked.Exchange(&inputDirty, 0) <> 0 - // #endif - // match inner with - // | ValueNone -> - // let result = mapping va - // inner <- ValueSome (struct (va, result)) - // result.GetValue token - - // | ValueSome(struct (oa, oldResult)) when not inputDirty || equals oa va -> - // oldResult.GetValue token - - // | ValueSome(struct (_, old)) -> - // old.Outputs.Remove x |> ignore - // let result = mapping va - // inner <- ValueSome (struct (va, result)) - // result.GetValue token - - // let mapBy equals mapping input = MapByVal(equals, mapping, input) :> aval<_> - - // let bindBy equals mapping input = BindByVal(equals, mapping, input) :> aval<_> - let mapOption f = AVal.map (Option.map f) /// diff --git a/src/FsAutoComplete.Core/FsAutoComplete.Core.fsproj b/src/FsAutoComplete.Core/FsAutoComplete.Core.fsproj index 772f1240e..dda511272 100644 --- a/src/FsAutoComplete.Core/FsAutoComplete.Core.fsproj +++ b/src/FsAutoComplete.Core/FsAutoComplete.Core.fsproj @@ -2,8 +2,6 @@ net8.0 net8.0;net9.0 - net9.0 - $(TargetFrameworks);net9.0 false $(NoWarn);FS0057 diff --git a/src/FsAutoComplete/FsAutoComplete.fsproj b/src/FsAutoComplete/FsAutoComplete.fsproj index 16e78a007..d50fd1309 100644 --- a/src/FsAutoComplete/FsAutoComplete.fsproj +++ b/src/FsAutoComplete/FsAutoComplete.fsproj @@ -4,8 +4,6 @@ Exe net8.0 net8.0;net9.0 - net9.0 - $(TargetFrameworks);net9.0 fsautocomplete true true @@ -50,8 +48,6 @@ - - From fa2fc6dcaee2abc32444f73714d1fcb6e146692b Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Sun, 8 Dec 2024 14:30:01 -0500 Subject: [PATCH 5/5] Undo maxConcurrency testing --- src/FsAutoComplete.Core/Utils.fs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/FsAutoComplete.Core/Utils.fs b/src/FsAutoComplete.Core/Utils.fs index 22cdf57e3..f440172b2 100644 --- a/src/FsAutoComplete.Core/Utils.fs +++ b/src/FsAutoComplete.Core/Utils.fs @@ -239,11 +239,10 @@ module Async = /// Creates an asynchronous computation that executes all the given asynchronous computations, using 75% of the Environment.ProcessorCount /// A sequence of distinct computations to be parallelized. let parallel75 computations = - // let maxConcurrency = - // Math.Max(1.0, Math.Floor((float System.Environment.ProcessorCount) * 0.75)) + let maxConcurrency = + Math.Max(1.0, Math.Floor((float System.Environment.ProcessorCount) * 0.75)) - // Async.Parallel(computations, int maxConcurrency) - Async.Parallel computations + Async.Parallel(computations, int maxConcurrency) [] module Array =