diff --git a/FSharp.Benchmarks.sln b/FSharp.Benchmarks.sln index e04c208232f..f690db4eaf8 100644 --- a/FSharp.Benchmarks.sln +++ b/FSharp.Benchmarks.sln @@ -13,10 +13,6 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.DependencyManager.Nu EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MicroPerf", "tests\benchmarks\CompiledCodeBenchmarks\MicroPerf\MicroPerf.fsproj", "{ED766F38-BD2B-436B-AF73-7BE6FAE061DD}" EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "TaskPerf", "tests\benchmarks\CompiledCodeBenchmarks\TaskPerf\TaskPerf\TaskPerf.fsproj", "{4779C245-9B85-4491-85EB-B0AF6D818E81}" -EndProject -Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "TaskPerfCSharp", "tests\benchmarks\CompiledCodeBenchmarks\TaskPerf\TaskPerfCSharp\TaskPerfCSharp.csproj", "{38CAA9B6-E4B8-42CB-B4E3-C2DC7D481913}" -EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "HistoricalBenchmark", "tests\benchmarks\FCSBenchmarks\BenchmarkComparison\HistoricalBenchmark.fsproj", "{66E23120-5E94-49AE-A263-24583007F5F5}" EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "HistoricalBenchmark.Runner", "tests\benchmarks\FCSBenchmarks\BenchmarkComparison\HistoricalBenchmark.Runner\HistoricalBenchmark.Runner.fsproj", "{2A1289B1-1539-48CB-BE03-807FE4BC0387}" @@ -71,18 +67,6 @@ Global {ED766F38-BD2B-436B-AF73-7BE6FAE061DD}.Release|Any CPU.Build.0 = Release|Any CPU {ED766F38-BD2B-436B-AF73-7BE6FAE061DD}.ReleaseCompressed|Any CPU.ActiveCfg = Debug|Any CPU {ED766F38-BD2B-436B-AF73-7BE6FAE061DD}.Proto|Any CPU.ActiveCfg = Debug|Any CPU - {4779C245-9B85-4491-85EB-B0AF6D818E81}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {4779C245-9B85-4491-85EB-B0AF6D818E81}.Debug|Any CPU.Build.0 = Debug|Any CPU - {4779C245-9B85-4491-85EB-B0AF6D818E81}.Release|Any CPU.ActiveCfg = Release|Any CPU - {4779C245-9B85-4491-85EB-B0AF6D818E81}.Release|Any CPU.Build.0 = Release|Any CPU - {4779C245-9B85-4491-85EB-B0AF6D818E81}.ReleaseCompressed|Any CPU.ActiveCfg = Debug|Any CPU - {4779C245-9B85-4491-85EB-B0AF6D818E81}.Proto|Any CPU.ActiveCfg = Debug|Any CPU - {38CAA9B6-E4B8-42CB-B4E3-C2DC7D481913}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {38CAA9B6-E4B8-42CB-B4E3-C2DC7D481913}.Debug|Any CPU.Build.0 = Debug|Any CPU - {38CAA9B6-E4B8-42CB-B4E3-C2DC7D481913}.Release|Any CPU.ActiveCfg = Release|Any CPU - {38CAA9B6-E4B8-42CB-B4E3-C2DC7D481913}.Release|Any CPU.Build.0 = Release|Any CPU - {38CAA9B6-E4B8-42CB-B4E3-C2DC7D481913}.ReleaseCompressed|Any CPU.ActiveCfg = Debug|Any CPU - {38CAA9B6-E4B8-42CB-B4E3-C2DC7D481913}.Proto|Any CPU.ActiveCfg = Debug|Any CPU {66E23120-5E94-49AE-A263-24583007F5F5}.Debug|Any CPU.ActiveCfg = Release|Any CPU {66E23120-5E94-49AE-A263-24583007F5F5}.Release|Any CPU.ActiveCfg = Release|Any CPU {66E23120-5E94-49AE-A263-24583007F5F5}.Release|Any CPU.Build.0 = Release|Any CPU diff --git a/FSharp.sln b/FSharp.sln index 5ce2e4eeb35..279b33bdd7f 100644 --- a/FSharp.sln +++ b/FSharp.sln @@ -42,10 +42,6 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Benchmarks", "Benchmarks", tests\benchmarks\README.md = tests\benchmarks\README.md EndProjectSection EndProject -Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "TaskPerfCSharp", "tests\benchmarks\CompiledCodeBenchmarks\TaskPerf\TaskPerfCSharp\TaskPerfCSharp.csproj", "{CF9F3F98-7BFB-4945-A4A5-668DF0AC65AB}" -EndProject -Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "TaskPerf", "tests\benchmarks\CompiledCodeBenchmarks\TaskPerf\TaskPerf\TaskPerf.fsproj", "{51B569A8-17C5-4EBD-8AAC-240E0B3AD8C4}" -EndProject Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "FSharp.Compiler.Service.Tests support", "FSharp.Compiler.Service.Tests support", "{452EED3C-AA87-471F-B9AC-0F4479C5820C}" EndProject Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "CSharp_Analysis", "tests\service\data\CSharp_Analysis\CSharp_Analysis.csproj", "{F8743670-C8D4-41B3-86BE-BBB1226C352F}" @@ -274,30 +270,6 @@ Global {9B4CF83C-C215-4EA0-9F8B-B5A77090F634}.Release|Any CPU.Build.0 = Release|Any CPU {9B4CF83C-C215-4EA0-9F8B-B5A77090F634}.Release|x86.ActiveCfg = Release|Any CPU {9B4CF83C-C215-4EA0-9F8B-B5A77090F634}.Release|x86.Build.0 = Release|Any CPU - {CF9F3F98-7BFB-4945-A4A5-668DF0AC65AB}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {CF9F3F98-7BFB-4945-A4A5-668DF0AC65AB}.Debug|Any CPU.Build.0 = Debug|Any CPU - {CF9F3F98-7BFB-4945-A4A5-668DF0AC65AB}.Debug|x86.ActiveCfg = Debug|Any CPU - {CF9F3F98-7BFB-4945-A4A5-668DF0AC65AB}.Debug|x86.Build.0 = Debug|Any CPU - {CF9F3F98-7BFB-4945-A4A5-668DF0AC65AB}.Proto|Any CPU.ActiveCfg = Debug|Any CPU - {CF9F3F98-7BFB-4945-A4A5-668DF0AC65AB}.Proto|Any CPU.Build.0 = Debug|Any CPU - {CF9F3F98-7BFB-4945-A4A5-668DF0AC65AB}.Proto|x86.ActiveCfg = Debug|Any CPU - {CF9F3F98-7BFB-4945-A4A5-668DF0AC65AB}.Proto|x86.Build.0 = Debug|Any CPU - {CF9F3F98-7BFB-4945-A4A5-668DF0AC65AB}.Release|Any CPU.ActiveCfg = Release|Any CPU - {CF9F3F98-7BFB-4945-A4A5-668DF0AC65AB}.Release|Any CPU.Build.0 = Release|Any CPU - {CF9F3F98-7BFB-4945-A4A5-668DF0AC65AB}.Release|x86.ActiveCfg = Release|Any CPU - {CF9F3F98-7BFB-4945-A4A5-668DF0AC65AB}.Release|x86.Build.0 = Release|Any CPU - {51B569A8-17C5-4EBD-8AAC-240E0B3AD8C4}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {51B569A8-17C5-4EBD-8AAC-240E0B3AD8C4}.Debug|Any CPU.Build.0 = Debug|Any CPU - {51B569A8-17C5-4EBD-8AAC-240E0B3AD8C4}.Debug|x86.ActiveCfg = Debug|Any CPU - {51B569A8-17C5-4EBD-8AAC-240E0B3AD8C4}.Debug|x86.Build.0 = Debug|Any CPU - {51B569A8-17C5-4EBD-8AAC-240E0B3AD8C4}.Proto|Any CPU.ActiveCfg = Debug|Any CPU - {51B569A8-17C5-4EBD-8AAC-240E0B3AD8C4}.Proto|Any CPU.Build.0 = Debug|Any CPU - {51B569A8-17C5-4EBD-8AAC-240E0B3AD8C4}.Proto|x86.ActiveCfg = Debug|Any CPU - {51B569A8-17C5-4EBD-8AAC-240E0B3AD8C4}.Proto|x86.Build.0 = Debug|Any CPU - {51B569A8-17C5-4EBD-8AAC-240E0B3AD8C4}.Release|Any CPU.ActiveCfg = Release|Any CPU - {51B569A8-17C5-4EBD-8AAC-240E0B3AD8C4}.Release|Any CPU.Build.0 = Release|Any CPU - {51B569A8-17C5-4EBD-8AAC-240E0B3AD8C4}.Release|x86.ActiveCfg = Release|Any CPU - {51B569A8-17C5-4EBD-8AAC-240E0B3AD8C4}.Release|x86.Build.0 = Release|Any CPU {F8743670-C8D4-41B3-86BE-BBB1226C352F}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {F8743670-C8D4-41B3-86BE-BBB1226C352F}.Debug|Any CPU.Build.0 = Debug|Any CPU {F8743670-C8D4-41B3-86BE-BBB1226C352F}.Debug|x86.ActiveCfg = Debug|Any CPU @@ -448,8 +420,6 @@ Global {FAC5A3BF-C0D6-437A-868A-E962AA00B418} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449} {DDFD06DC-D7F2-417F-9177-107764EEBCD8} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449} {9B4CF83C-C215-4EA0-9F8B-B5A77090F634} = {3881429D-A97A-49EB-B7AE-A82BA5FE9C77} - {CF9F3F98-7BFB-4945-A4A5-668DF0AC65AB} = {CE70D631-C5DC-417E-9CDA-B16097BEF1AC} - {51B569A8-17C5-4EBD-8AAC-240E0B3AD8C4} = {CE70D631-C5DC-417E-9CDA-B16097BEF1AC} {452EED3C-AA87-471F-B9AC-0F4479C5820C} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449} {F8743670-C8D4-41B3-86BE-BBB1226C352F} = {452EED3C-AA87-471F-B9AC-0F4479C5820C} {7BFA159A-BF9D-4489-BF46-1B83ACCEEE0F} = {452EED3C-AA87-471F-B9AC-0F4479C5820C} diff --git a/VisualFSharp.sln b/VisualFSharp.sln index 486cc03a163..b6e700de8cd 100644 --- a/VisualFSharp.sln +++ b/VisualFSharp.sln @@ -143,10 +143,6 @@ Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "LibraryProject", "vsintegra EndProject Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "TutorialProject", "vsintegration\ProjectTemplates\TutorialProject\TutorialProject.csproj", "{2937CBEC-262D-4C94-BE1D-291FAB72E3E8}" EndProject -Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "TaskPerfCSharp", "tests\benchmarks\CompiledCodeBenchmarks\TaskPerf\TaskPerfCSharp\TaskPerfCSharp.csproj", "{D5ECF8DF-E150-4AE3-B613-AB2B0FFA93E0}" -EndProject -Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "TaskPerf", "tests\benchmarks\CompiledCodeBenchmarks\TaskPerf\TaskPerf\TaskPerf.fsproj", "{03596D51-754D-4644-8E23-84EC9532ABDC}" -EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Compiler.ComponentTests", "tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj", "{0610FB97-7C15-422A-86FD-32335C6DF14D}" EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Compiler.Service", "src\Compiler\FSharp.Compiler.Service.fsproj", "{B5A9BBD9-2F45-4722-A6CA-BAE3C64CD4E2}" @@ -817,30 +813,6 @@ Global {2937CBEC-262D-4C94-BE1D-291FAB72E3E8}.Release|Any CPU.Build.0 = Release|Any CPU {2937CBEC-262D-4C94-BE1D-291FAB72E3E8}.Release|x86.ActiveCfg = Release|Any CPU {2937CBEC-262D-4C94-BE1D-291FAB72E3E8}.Release|x86.Build.0 = Release|Any CPU - {D5ECF8DF-E150-4AE3-B613-AB2B0FFA93E0}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {D5ECF8DF-E150-4AE3-B613-AB2B0FFA93E0}.Debug|Any CPU.Build.0 = Debug|Any CPU - {D5ECF8DF-E150-4AE3-B613-AB2B0FFA93E0}.Debug|x86.ActiveCfg = Debug|Any CPU - {D5ECF8DF-E150-4AE3-B613-AB2B0FFA93E0}.Debug|x86.Build.0 = Debug|Any CPU - {D5ECF8DF-E150-4AE3-B613-AB2B0FFA93E0}.Proto|Any CPU.ActiveCfg = Debug|Any CPU - {D5ECF8DF-E150-4AE3-B613-AB2B0FFA93E0}.Proto|Any CPU.Build.0 = Debug|Any CPU - {D5ECF8DF-E150-4AE3-B613-AB2B0FFA93E0}.Proto|x86.ActiveCfg = Debug|Any CPU - {D5ECF8DF-E150-4AE3-B613-AB2B0FFA93E0}.Proto|x86.Build.0 = Debug|Any CPU - {D5ECF8DF-E150-4AE3-B613-AB2B0FFA93E0}.Release|Any CPU.ActiveCfg = Release|Any CPU - {D5ECF8DF-E150-4AE3-B613-AB2B0FFA93E0}.Release|Any CPU.Build.0 = Release|Any CPU - {D5ECF8DF-E150-4AE3-B613-AB2B0FFA93E0}.Release|x86.ActiveCfg = Release|Any CPU - {D5ECF8DF-E150-4AE3-B613-AB2B0FFA93E0}.Release|x86.Build.0 = Release|Any CPU - {03596D51-754D-4644-8E23-84EC9532ABDC}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {03596D51-754D-4644-8E23-84EC9532ABDC}.Debug|Any CPU.Build.0 = Debug|Any CPU - {03596D51-754D-4644-8E23-84EC9532ABDC}.Debug|x86.ActiveCfg = Debug|Any CPU - {03596D51-754D-4644-8E23-84EC9532ABDC}.Debug|x86.Build.0 = Debug|Any CPU - {03596D51-754D-4644-8E23-84EC9532ABDC}.Proto|Any CPU.ActiveCfg = Debug|Any CPU - {03596D51-754D-4644-8E23-84EC9532ABDC}.Proto|Any CPU.Build.0 = Debug|Any CPU - {03596D51-754D-4644-8E23-84EC9532ABDC}.Proto|x86.ActiveCfg = Debug|Any CPU - {03596D51-754D-4644-8E23-84EC9532ABDC}.Proto|x86.Build.0 = Debug|Any CPU - {03596D51-754D-4644-8E23-84EC9532ABDC}.Release|Any CPU.ActiveCfg = Release|Any CPU - {03596D51-754D-4644-8E23-84EC9532ABDC}.Release|Any CPU.Build.0 = Release|Any CPU - {03596D51-754D-4644-8E23-84EC9532ABDC}.Release|x86.ActiveCfg = Release|Any CPU - {03596D51-754D-4644-8E23-84EC9532ABDC}.Release|x86.Build.0 = Release|Any CPU {0610FB97-7C15-422A-86FD-32335C6DF14D}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {0610FB97-7C15-422A-86FD-32335C6DF14D}.Debug|Any CPU.Build.0 = Debug|Any CPU {0610FB97-7C15-422A-86FD-32335C6DF14D}.Debug|x86.ActiveCfg = Debug|Any CPU @@ -1095,8 +1067,6 @@ Global {44155269-9B30-43DA-B97F-4F36F887B211} = {12EF27FD-A34B-4373-860A-F9FCE9651859} {B53D9D05-8EF7-43A6-9A5B-0B113CBC54F8} = {12EF27FD-A34B-4373-860A-F9FCE9651859} {2937CBEC-262D-4C94-BE1D-291FAB72E3E8} = {12EF27FD-A34B-4373-860A-F9FCE9651859} - {D5ECF8DF-E150-4AE3-B613-AB2B0FFA93E0} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449} - {03596D51-754D-4644-8E23-84EC9532ABDC} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449} {0610FB97-7C15-422A-86FD-32335C6DF14D} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449} {B5A9BBD9-2F45-4722-A6CA-BAE3C64CD4E2} = {3881429D-A97A-49EB-B7AE-A82BA5FE9C77} {14F3D3D6-5C8E-43C2-98A2-17EA704D4DEA} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449} diff --git a/tests/benchmarks/CompiledCodeBenchmarks/MicroPerf/Async.fs b/tests/benchmarks/CompiledCodeBenchmarks/MicroPerf/Async.fs index 4e7028e692e..aee633f8fab 100644 --- a/tests/benchmarks/CompiledCodeBenchmarks/MicroPerf/Async.fs +++ b/tests/benchmarks/CompiledCodeBenchmarks/MicroPerf/Async.fs @@ -2,7 +2,7 @@ module Async open BenchmarkDotNet.Attributes -[] +[] [] [] [] diff --git a/tests/benchmarks/CompiledCodeBenchmarks/MicroPerf/CS/MicroPerfCSharp.csproj b/tests/benchmarks/CompiledCodeBenchmarks/MicroPerf/CS/MicroPerfCSharp.csproj index 168c8b546e6..85aa34100c2 100644 --- a/tests/benchmarks/CompiledCodeBenchmarks/MicroPerf/CS/MicroPerfCSharp.csproj +++ b/tests/benchmarks/CompiledCodeBenchmarks/MicroPerf/CS/MicroPerfCSharp.csproj @@ -1,7 +1,6 @@ - $(FSharpNetCoreProductTargetFramework) Library 8.0 @@ -11,8 +10,4 @@ $(NoWarn);CS1591 - - - - \ No newline at end of file diff --git a/tests/benchmarks/CompiledCodeBenchmarks/MicroPerf/Collections.fs b/tests/benchmarks/CompiledCodeBenchmarks/MicroPerf/Collections.fs index fa6178e6778..50f1719c5b5 100644 --- a/tests/benchmarks/CompiledCodeBenchmarks/MicroPerf/Collections.fs +++ b/tests/benchmarks/CompiledCodeBenchmarks/MicroPerf/Collections.fs @@ -2,7 +2,7 @@ module Collections open BenchmarkDotNet.Attributes -[] +[] [] [] [] diff --git a/tests/benchmarks/CompiledCodeBenchmarks/MicroPerf/MicroPerf.fsproj b/tests/benchmarks/CompiledCodeBenchmarks/MicroPerf/MicroPerf.fsproj index fc36640d7e6..9fc704b2ce5 100644 --- a/tests/benchmarks/CompiledCodeBenchmarks/MicroPerf/MicroPerf.fsproj +++ b/tests/benchmarks/CompiledCodeBenchmarks/MicroPerf/MicroPerf.fsproj @@ -1,8 +1,6 @@  - $(FSharpNetCoreProductTargetFramework) Exe - true $(OtherFlags) --nowarn:1204 @@ -26,7 +24,6 @@ - - + \ No newline at end of file diff --git a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/TaskBuilder.fs b/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/TaskBuilder.fs deleted file mode 100644 index 9d3683e4b27..00000000000 --- a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/TaskBuilder.fs +++ /dev/null @@ -1,416 +0,0 @@ -// TaskBuilder.fs - TPL task computation expressions for F# -// -// Written in 2016 by Robert Peele (humbobst@gmail.com) -// New operator-based overload resolution for F# 4.0 compatibility by Gustavo Leon in 2018. -// -// To the extent possible under law, the author(s) have dedicated all copyright and related and neighboring rights -// to this software to the public domain worldwide. This software is distributed without any warranty. -// -// You should have received a copy of the CC0 Public Domain Dedication along with this software. -// If not, see . - -namespace TaskBuilderTasks -open System -open System.Threading.Tasks -open System.Runtime.CompilerServices - -// This module is not really obsolete, but it's not intended to be referenced directly from user code. -// However, it can't be private because it is used within inline functions that *are* user-visible. -// Marking it as obsolete is a workaround to hide it from auto-completion tools. -[] -module TaskBuilder = - /// Represents the state of a computation: - /// either awaiting something with a continuation, - /// or completed with a return value. - type Step<'a> = - | Await of ICriticalNotifyCompletion * (unit -> Step<'a>) - | Return of 'a - /// We model tail calls explicitly, but still can't run them without O(n) memory usage. - | ReturnFrom of 'a Task - /// Implements the machinery of running a `Step<'m, 'm>` as a task returning a continuation task. - and StepStateMachine<'a>(firstStep) as this = - let methodBuilder = AsyncTaskMethodBuilder<'a Task>() - /// The continuation we left off awaiting on our last MoveNext(). - let mutable continuation = fun () -> firstStep - /// Returns next pending awaitable or null if exiting (including tail call). - let nextAwaitable() = - try - match continuation() with - | Return r -> - methodBuilder.SetResult(Task.FromResult(r)) - null - | ReturnFrom t -> - methodBuilder.SetResult(t) - null - | Await (await, next) -> - continuation <- next - await - with - | exn -> - methodBuilder.SetException(exn) - null - let mutable self = this - - /// Start execution as a `Task>`. - member __.Run() = - methodBuilder.Start(&self) - methodBuilder.Task - - interface IAsyncStateMachine with - /// Proceed to one of three states: result, failure, or awaiting. - /// If awaiting, MoveNext() will be called again when the awaitable completes. - member __.MoveNext() = - let mutable await = nextAwaitable() - if not (isNull await) then - // Tell the builder to call us again when this thing is done. - methodBuilder.AwaitUnsafeOnCompleted(&await, &self) - member __.SetStateMachine(_) = () // Doesn't really apply since we're a reference type. - - let unwrapException (agg : AggregateException) = - let inners = agg.InnerExceptions - if inners.Count = 1 then inners.[0] - else agg :> Exception - - /// Used to represent no-ops like the implicit empty "else" branch of an "if" expression. - let zero = Return () - - /// Used to return a value. - let ret (x : 'a) = Return x - - type Binder<'out> = - // We put the output generic parameter up here at the class level, so it doesn't get subject to - // inline rules. If we put it all in the inline function, then the compiler gets confused at the - // below and demands that the whole function either is limited to working with (x : obj), or must - // be inline itself. - // - // let yieldThenReturn (x : 'a) = - // task { - // do! Task.Yield() - // return x - // } - - static member inline GenericAwait< ^abl, ^awt, ^inp - when ^abl : (member GetAwaiter : unit -> ^awt) - and ^awt :> ICriticalNotifyCompletion - and ^awt : (member get_IsCompleted : unit -> bool) - and ^awt : (member GetResult : unit -> ^inp) > - (abl : ^abl, continuation : ^inp -> 'out Step) : 'out Step = - let awt = (^abl : (member GetAwaiter : unit -> ^awt)(abl)) // get an awaiter from the awaitable - if (^awt : (member get_IsCompleted : unit -> bool)(awt)) then // shortcut to continue immediately - continuation (^awt : (member GetResult : unit -> ^inp)(awt)) - else - Await (awt, fun () -> continuation (^awt : (member GetResult : unit -> ^inp)(awt))) - - static member inline GenericAwaitConfigureFalse< ^tsk, ^abl, ^awt, ^inp - when ^tsk : (member ConfigureAwait : bool -> ^abl) - and ^abl : (member GetAwaiter : unit -> ^awt) - and ^awt :> ICriticalNotifyCompletion - and ^awt : (member get_IsCompleted : unit -> bool) - and ^awt : (member GetResult : unit -> ^inp) > - (tsk : ^tsk, continuation : ^inp -> 'out Step) : 'out Step = - let abl = (^tsk : (member ConfigureAwait : bool -> ^abl)(tsk, false)) - Binder<'out>.GenericAwait(abl, continuation) - - /// Special case of the above for `Task<'a>`. Have to write this out by hand to avoid confusing the compiler - /// trying to decide between satisfying the constraints with `Task` or `Task<'a>`. - let bindTask (task : 'a Task) (continuation : 'a -> Step<'b>) = - let awt = task.GetAwaiter() - if awt.IsCompleted then // Proceed to the next step based on the result we already have. - continuation(awt.GetResult()) - else // Await and continue later when a result is available. - Await (awt, (fun () -> continuation(awt.GetResult()))) - - /// Special case of the above for `Task<'a>`, for the context-insensitive builder. - /// Have to write this out by hand to avoid confusing the compiler thinking our built-in bind method - /// defined on the builder has fancy generic constraints on inp and out parameters. - let bindTaskConfigureFalse (task : 'a Task) (continuation : 'a -> Step<'b>) = - let awt = task.ConfigureAwait(false).GetAwaiter() - if awt.IsCompleted then // Proceed to the next step based on the result we already have. - continuation(awt.GetResult()) - else // Await and continue later when a result is available. - Await (awt, (fun () -> continuation(awt.GetResult()))) - - /// Chains together a step with its following step. - /// Note that this requires that the first step has no result. - /// This prevents constructs like `task { return 1; return 2; }`. - let rec combine (step : Step) (continuation : unit -> Step<'b>) = - match step with - | Return _ -> continuation() - | ReturnFrom t -> - Await (t.GetAwaiter(), continuation) - | Await (awaitable, next) -> - Await (awaitable, fun () -> combine (next()) continuation) - - /// Builds a step that executes the body while the condition predicate is true. - let whileLoop (cond : unit -> bool) (body : unit -> Step) = - if cond() then - // Create a self-referencing closure to test whether to repeat the loop on future iterations. - let rec repeat () = - if cond() then - let body = body() - match body with - | Return _ -> repeat() - | ReturnFrom t -> Await(t.GetAwaiter(), repeat) - | Await (awaitable, next) -> - Await (awaitable, fun () -> combine (next()) repeat) - else zero - // Run the body the first time and chain it to the repeat logic. - combine (body()) repeat - else zero - - /// Wraps a step in a try/with. This catches exceptions both in the evaluation of the function - /// to retrieve the step, and in the continuation of the step (if any). - let rec tryWith(step : unit -> Step<'a>) (catch : exn -> Step<'a>) = - try - match step() with - | Return _ as i -> i - | ReturnFrom t -> - let awaitable = t.GetAwaiter() - Await(awaitable, fun () -> - try - awaitable.GetResult() |> Return - with - | exn -> catch exn) - | Await (awaitable, next) -> Await (awaitable, fun () -> tryWith next catch) - with - | exn -> catch exn - - /// Wraps a step in a try/finally. This catches exceptions both in the evaluation of the function - /// to retrieve the step, and in the continuation of the step (if any). - let rec tryFinally (step : unit -> Step<'a>) fin = - let step = - try step() - // Important point: we use a try/with, not a try/finally, to implement tryFinally. - // The reason for this is that if we're just building a continuation, we definitely *shouldn't* - // execute the `fin()` part yet -- the actual execution of the asynchronous code hasn't completed! - with - | _ -> - fin() - reraise() - match step with - | Return _ as i -> - fin() - i - | ReturnFrom t -> - let awaitable = t.GetAwaiter() - Await(awaitable, fun () -> - let result = - try - awaitable.GetResult() |> Return - with - | _ -> - fin() - reraise() - fin() // if we got here we haven't run fin(), because we would've reraised after doing so - result) - | Await (awaitable, next) -> - Await (awaitable, fun () -> tryFinally next fin) - - /// Implements a using statement that disposes `disp` after `body` has completed. - let using (disp : #IDisposable) (body : _ -> Step<'a>) = - // A using statement is just a try/finally with the finally block disposing if non-null. - tryFinally - (fun () -> body disp) - (fun () -> if not (isNull (box disp)) then disp.Dispose()) - - /// Implements a loop that runs `body` for each element in `sequence`. - let forLoop (sequence : 'a seq) (body : 'a -> Step) = - // A for loop is just a using statement on the sequence's enumerator... - using (sequence.GetEnumerator()) - // ... and its body is a while loop that advances the enumerator and runs the body on each element. - (fun e -> whileLoop e.MoveNext (fun () -> body e.Current)) - - /// Runs a step as a task -- with a short-circuit for immediately completed steps. - let run (firstStep : unit -> Step<'a>) = - try - match firstStep() with - | Return x -> Task.FromResult(x) - | ReturnFrom t -> t - | Await _ as step -> StepStateMachine<'a>(step).Run().Unwrap() // sadly can't do tail recursion - // Any exceptions should go on the task, rather than being thrown from this call. - // This matches C# behavior where you won't see an exception until awaiting the task, - // even if it failed before reaching the first "await". - with - | exn -> - let src = new TaskCompletionSource<_>() - src.SetException(exn) - src.Task - - // We have to have a dedicated overload for Task<'a> so the compiler doesn't get confused with Convenience overloads for Asyncs - // Everything else can use bindGenericAwaitable via an extension member - - type Priority3 = obj - type Priority2 = IComparable - - type BindS = Priority1 with - static member inline (>>=) (_:Priority2, taskLike : 't) = fun (k: _ -> 'b Step) -> Binder<'b>.GenericAwait (taskLike, k): 'b Step - static member (>>=) ( Priority1, task: 'a Task) = fun (k: 'a -> 'b Step) -> bindTask task k : 'b Step - static member (>>=) ( Priority1, a : 'a Async) = fun (k: 'a -> 'b Step) -> bindTask (Async.StartAsTask a) k : 'b Step - - type ReturnFromS = Priority1 with - static member inline ($) (Priority1, taskLike ) = Binder<_>.GenericAwait (taskLike, ret) - static member ($) (Priority1, a : 'a Async) = bindTask (Async.StartAsTask a) ret : Step<'a> - - type BindI = Priority1 with - static member inline (>>=) (_:Priority3, taskLike : 't) = fun (k : _ -> 'b Step) -> Binder<'b>.GenericAwait (taskLike, k) : 'b Step - static member inline (>>=) (_:Priority2, configurableTaskLike: 't) = fun (k : _ -> 'b Step) -> Binder<'b>.GenericAwaitConfigureFalse (configurableTaskLike, k): 'b Step - static member (>>=) ( Priority1, task: 'a Task ) = fun (k : 'a -> 'b Step) -> bindTaskConfigureFalse task k : 'b Step - static member (>>=) ( Priority1, a : 'a Async ) = fun (k : 'a -> 'b Step) -> bindTaskConfigureFalse (Async.StartAsTask a) k : 'b Step - - type ReturnFromI = Priority1 with - static member inline ($) (_:Priority2, taskLike ) = Binder<_>.GenericAwait(taskLike, ret) - static member inline ($) ( Priority1, configurableTaskLike) = Binder<_>.GenericAwaitConfigureFalse(configurableTaskLike, ret) - static member ($) ( Priority1, a : 'a Async ) = bindTaskConfigureFalse (Async.StartAsTask a) ret - - // New style task builder. - type TaskBuilderV2() = - // These methods are consistent between all builders. - member __.Delay(f : unit -> Step<_>) = f - member __.Run(f : unit -> Step<'m>) = run f - member __.Zero() = zero - member __.Return(x) = ret x - member __.Combine(step : unit Step, continuation) = combine step continuation - member __.While(condition : unit -> bool, body : unit -> unit Step) = whileLoop condition body - member __.For(sequence : _ seq, body : _ -> unit Step) = forLoop sequence body - member __.TryWith(body : unit -> _ Step, catch : exn -> _ Step) = tryWith body catch - member __.TryFinally(body : unit -> _ Step, fin : unit -> unit) = tryFinally body fin - member __.Using(disp : #IDisposable, body : #IDisposable -> _ Step) = using disp body - member __.ReturnFrom a : _ Step = ReturnFrom a - - // Old style task builder. Retained for binary compatibility. - type TaskBuilder() = - // These methods are consistent between the two builders. - // Unfortunately, inline members do not work with inheritance. - member inline __.Delay(f : unit -> Step<_>) = f - member inline __.Run(f : unit -> Step<'m>) = run f - member inline __.Zero() = zero - member inline __.Return(x) = ret x - member inline __.Combine(step : unit Step, continuation) = combine step continuation - member inline __.While(condition : unit -> bool, body : unit -> unit Step) = whileLoop condition body - member inline __.For(sequence : _ seq, body : _ -> unit Step) = forLoop sequence body - member inline __.TryWith(body : unit -> _ Step, catch : exn -> _ Step) = tryWith body catch - member inline __.TryFinally(body : unit -> _ Step, fin : unit -> unit) = tryFinally body fin - member inline __.Using(disp : #IDisposable, body : #IDisposable -> _ Step) = using disp body - // End of consistent methods -- the following methods are different between - // `TaskBuilder` and `ContextInsensitiveTaskBuilder`! - - // We have to have a dedicated overload for Task<'a> so the compiler doesn't get confused. - // Everything else can use bindGenericAwaitable via an extension member (defined later). - member inline __.ReturnFrom(task : _ Task) = ReturnFrom task - member inline __.Bind(task : 'a Task, continuation : 'a -> 'b Step) : 'b Step = - bindTask task continuation - - // Old style task builder. Retained for binary compatibility. - type ContextInsensitiveTaskBuilder() = - // These methods are consistent between the two builders. - // Unfortunately, inline members do not work with inheritance. - member inline __.Delay(f : unit -> Step<_>) = f - member inline __.Run(f : unit -> Step<'m>) = run f - member inline __.Zero() = zero - member inline __.Return(x) = ret x - member inline __.Combine(step : unit Step, continuation) = combine step continuation - member inline __.While(condition : unit -> bool, body : unit -> unit Step) = whileLoop condition body - member inline __.For(sequence : _ seq, body : _ -> unit Step) = forLoop sequence body - member inline __.TryWith(body : unit -> _ Step, catch : exn -> _ Step) = tryWith body catch - member inline __.TryFinally(body : unit -> _ Step, fin : unit -> unit) = tryFinally body fin - member inline __.Using(disp : #IDisposable, body : #IDisposable -> _ Step) = using disp body - // End of consistent methods -- the following methods are different between - // `TaskBuilder` and `ContextInsensitiveTaskBuilder`! - - // We have to have a dedicated overload for Task<'a> so the compiler doesn't get confused. - // Everything else can use bindGenericAwaitable via an extension member (defined later). - member inline __.ReturnFrom(task : _ Task) = ReturnFrom task - member inline __.Bind(task : 'a Task, continuation : 'a -> 'b Step) : 'b Step = - bindTaskConfigureFalse task continuation - - -// Don't warn about our use of the "obsolete" module we just defined (see notes at start of file). -#nowarn "44" - -[] -module ContextSensitive = - /// Builds a `System.Threading.Tasks.Task<'a>` similarly to a C# async/await method. - /// Use this like `task { let! taskResult = someTask(); return taskResult.ToString(); }`. - let taskBuilder = TaskBuilder.TaskBuilder() - - [] - let inline unitTask t = t :> Task - - // These are fallbacks when the Bind and ReturnFrom on the builder object itself don't apply. - // This is how we support binding arbitrary task-like types. - type TaskBuilder.TaskBuilder with - member inline this.ReturnFrom(taskLike) = - TaskBuilder.Binder<_>.GenericAwait(taskLike, TaskBuilder.ret) - member inline this.Bind(taskLike, continuation : _ -> 'a TaskBuilder.Step) : 'a TaskBuilder.Step = - TaskBuilder.Binder<'a>.GenericAwait(taskLike, continuation) - // Convenience overloads for Asyncs. - member __.ReturnFrom(a : 'a Async) = - TaskBuilder.bindTask (Async.StartAsTask a) TaskBuilder.ret - member __.Bind(a : 'a Async, continuation : 'a -> 'b TaskBuilder.Step) : 'b TaskBuilder.Step = - TaskBuilder.bindTask (Async.StartAsTask a) continuation - -module ContextInsensitive = - /// Builds a `System.Threading.Tasks.Task<'a>` similarly to a C# async/await method, but with - /// all awaited tasks automatically configured *not* to resume on the captured context. - /// This is often preferable when writing library code that is not context-aware, but undesirable when writing - /// e.g. code that must interact with user interface controls on the same thread as its caller. - let task = TaskBuilder.ContextInsensitiveTaskBuilder() - - [] - let inline unitTask (t : Task) = t.ConfigureAwait(false) - - // These are fallbacks when the Bind and ReturnFrom on the builder object itself don't apply. - // This is how we support binding arbitrary task-like types. - type TaskBuilder.ContextInsensitiveTaskBuilder with - member inline this.ReturnFrom(taskLike) = - TaskBuilder.Binder<_>.GenericAwait(taskLike, TaskBuilder.ret) - member inline this.Bind(taskLike, continuation : _ -> 'a TaskBuilder.Step) : 'a TaskBuilder.Step = - TaskBuilder.Binder<'a>.GenericAwait(taskLike, continuation) - - // Convenience overloads for Asyncs. - member __.ReturnFrom(a : 'a Async) = - TaskBuilder.bindTaskConfigureFalse (Async.StartAsTask a) TaskBuilder.ret - member __.Bind(a : 'a Async, continuation : 'a -> 'b TaskBuilder.Step) : 'b TaskBuilder.Step = - TaskBuilder.bindTaskConfigureFalse (Async.StartAsTask a) continuation - - [] - module HigherPriorityBinds = - // When it's possible for these to work, the compiler should prefer them since they shadow the ones above. - type TaskBuilder.ContextInsensitiveTaskBuilder with - member inline this.ReturnFrom(configurableTaskLike) = - TaskBuilder.Binder<_>.GenericAwaitConfigureFalse(configurableTaskLike, TaskBuilder.ret) - member inline this.Bind(configurableTaskLike, continuation : _ -> 'a TaskBuilder.Step) : 'a TaskBuilder.Step = - TaskBuilder.Binder<'a>.GenericAwaitConfigureFalse(configurableTaskLike, continuation) - - -module V2 = - [] - module ContextSensitive = - open TaskBuilder - - /// Builds a `System.Threading.Tasks.Task<'a>` similarly to a C# async/await method. - /// Use this like `task { let! taskResult = someTask(); return taskResult.ToString(); }`. - let taskBuilder = TaskBuilderV2() - - [] - let unitTask (t : Task) = t - - type TaskBuilderV2 with - member inline __.Bind (task, continuation : 'a -> 'b Step) : 'b Step = (BindS.Priority1 >>= task) continuation - member inline __.ReturnFrom a : 'b Step = ReturnFromS.Priority1 $ a - - module ContextInsensitive = - open TaskBuilder - - /// Builds a `System.Threading.Tasks.Task<'a>` similarly to a C# async/await method, but with - /// all awaited tasks automatically configured *not* to resume on the captured context. - /// This is often preferable when writing library code that is not context-aware, but undesirable when writing - /// e.g. code that must interact with user interface controls on the same thread as its caller. - let task = TaskBuilderV2() - - [] - let unitTask (t : Task) = t.ConfigureAwait(false) - - type TaskBuilderV2 with - member inline __.Bind (task, continuation : 'a -> 'b Step) : 'b Step = (BindI.Priority1 >>= task) continuation - member inline __.ReturnFrom a : 'b Step = ReturnFromI.Priority1 $ a \ No newline at end of file diff --git a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/TaskPerf.fs b/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/TaskPerf.fs deleted file mode 100644 index 6f89f4fd6eb..00000000000 --- a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/TaskPerf.fs +++ /dev/null @@ -1,468 +0,0 @@ -namespace TaskPerf - -open System -open System.Threading.Tasks -open System.IO -open BenchmarkDotNet.Attributes -open BenchmarkDotNet.Running -open TaskBuilderTasks //.ContextSensitive // TaskBuilder.fs extension members -open FSharp.Control // AsyncSeq -open Tests.SyncBuilder -open BenchmarkDotNet.Configs -#if PREVIEW -open FSharp.Control.Async2 -open Tests.TaskSeq -#endif - -[] -module Helpers = - let bufferSize = 128 - let manyIterations = 1000 - let syncTask() = Task.FromResult 100 - let syncTask_async() = async.Return 100 - let syncTask_async2() = Task.FromResult 100 - let asyncYield() = Async.Sleep(0) - let asyncTask() = Task.Yield() - - let tenBindSync_taskBuilder() = - taskBuilder { - let! res1 = syncTask() - let! res2 = syncTask() - let! res3 = syncTask() - let! res4 = syncTask() - let! res5 = syncTask() - let! res6 = syncTask() - let! res7 = syncTask() - let! res8 = syncTask() - let! res9 = syncTask() - let! res10 = syncTask() - return res1 + res2 + res3 + res4 + res5 + res6 + res7 + res8 + res9 + res10 - } - - let tenBindSync_async() = - async { - let! res1 = syncTask_async() - let! res2 = syncTask_async() - let! res3 = syncTask_async() - let! res4 = syncTask_async() - let! res5 = syncTask_async() - let! res6 = syncTask_async() - let! res7 = syncTask_async() - let! res8 = syncTask_async() - let! res9 = syncTask_async() - let! res10 = syncTask_async() - return res1 + res2 + res3 + res4 + res5 + res6 + res7 + res8 + res9 + res10 - } - -#if PREVIEW - let tenBindSync_task() = - task { - let! res1 = syncTask() - let! res2 = syncTask() - let! res3 = syncTask() - let! res4 = syncTask() - let! res5 = syncTask() - let! res6 = syncTask() - let! res7 = syncTask() - let! res8 = syncTask() - let! res9 = syncTask() - let! res10 = syncTask() - return res1 + res2 + res3 + res4 + res5 + res6 + res7 + res8 + res9 + res10 - } - - let tenBindSync_async2() = - async2 { - let! res1 = syncTask_async2() - let! res2 = syncTask_async2() - let! res3 = syncTask_async2() - let! res4 = syncTask_async2() - let! res5 = syncTask_async2() - let! res6 = syncTask_async2() - let! res7 = syncTask_async2() - let! res8 = syncTask_async2() - let! res9 = syncTask_async2() - let! res10 = syncTask_async2() - return res1 + res2 + res3 + res4 + res5 + res6 + res7 + res8 + res9 + res10 - } -#endif - - let tenBindAsync_taskBuilder() = - taskBuilder { - do! asyncTask() - do! asyncTask() - do! asyncTask() - do! asyncTask() - do! asyncTask() - do! asyncTask() - do! asyncTask() - do! asyncTask() - do! asyncTask() - do! asyncTask() - } - - let tenBindAsync_async() = - async { - do! asyncYield() - do! asyncYield() - do! asyncYield() - do! asyncYield() - do! asyncYield() - do! asyncYield() - do! asyncYield() - do! asyncYield() - do! asyncYield() - do! asyncYield() - } -#if PREVIEW - let tenBindAsync_task() = - task { - do! asyncTask() - do! asyncTask() - do! asyncTask() - do! asyncTask() - do! asyncTask() - do! asyncTask() - do! asyncTask() - do! asyncTask() - do! asyncTask() - do! asyncTask() - } - - let tenBindAsync_async2() = - async2 { - do! asyncTask() - do! asyncTask() - do! asyncTask() - do! asyncTask() - do! asyncTask() - do! asyncTask() - do! asyncTask() - do! asyncTask() - do! asyncTask() - do! asyncTask() - } -#endif - - let singleTask_taskBuilder() = - taskBuilder { return 1 } - - let singleTask_async() = - async { return 1 } -#if PREVIEW - let singleTask_task() = - task { return 1 } - - let singleTask_async2() = - async2 { return 1 } -#endif - -[] -[] -[] -type Benchmarks() = - - [] - member _.ManyWriteFile_CSharpTasks () = - TaskPerfCSharp.ManyWriteFileAsync(manyIterations).Wait(); - - [] - member _.ManyWriteFile_taskBuilder () = - let path = Path.GetTempFileName() - taskBuilder { - let junk = Array.zeroCreate bufferSize - use file = File.Create(path) - for i = 1 to manyIterations do - do! file.WriteAsync(junk, 0, junk.Length) - } - |> fun t -> t.Wait() - File.Delete(path) - - [] - member _.ManyWriteFile_async () = - let path = Path.GetTempFileName() - async { - let junk = Array.zeroCreate bufferSize - use file = File.Create(path) - for i = 1 to manyIterations do - do! Async.AwaitTask(file.WriteAsync(junk, 0, junk.Length)) - } - |> Async.RunSynchronously - File.Delete(path) - -#if PREVIEW - [] - member _.ManyWriteFile_task () = - let path = Path.GetTempFileName() - task { - let junk = Array.zeroCreate bufferSize - use file = File.Create(path) - for i = 1 to manyIterations do - do! file.WriteAsync(junk, 0, junk.Length) - } - |> fun t -> t.Wait() - File.Delete(path) - - [] - member _.ManyWriteFile_async2 () = - let path = Path.GetTempFileName() - async2 { - let junk = Array.zeroCreate bufferSize - use file = File.Create(path) - for i = 1 to manyIterations do - do! file.WriteAsync(junk, 0, junk.Length) - } - |> Async2.RunSynchronously - File.Delete(path) -#endif - - - - [] - member _.NonAsyncBinds_CSharpTasks() = - for i in 1 .. manyIterations*100 do - TaskPerfCSharp.TenBindsSync_CSharp().Wait() - - [] - member _.NonAsyncBinds_taskBuilder() = - for i in 1 .. manyIterations*100 do - tenBindSync_taskBuilder().Wait() - - [] - member _.NonAsyncBinds_async() = - for i in 1 .. manyIterations*100 do - tenBindSync_async() |> Async.RunSynchronously |> ignore - -#if PREVIEW - [] - member _.NonAsyncBinds_async2() = - for i in 1 .. manyIterations*100 do - tenBindSync_async2() |> Async2.RunSynchronously |> ignore - - [] - member _.NonAsyncBinds_task() = - for i in 1 .. manyIterations*100 do - tenBindSync_task().Wait() - -#endif - - - - - [] - member _.AsyncBinds_CSharpTasks() = - for i in 1 .. manyIterations do - TaskPerfCSharp.TenBindsAsync_CSharp().Wait() - - [] - member _.AsyncBinds_taskBuilder() = - for i in 1 .. manyIterations do - tenBindAsync_taskBuilder().Wait() - - [] - member _.AsyncBinds_async() = - for i in 1 .. manyIterations do - tenBindAsync_async() |> Async.RunSynchronously - -#if PREVIEW - [] - member _.AsyncBinds_task() = - for i in 1 .. manyIterations do - tenBindAsync_task().Wait() - - [] - member _.AsyncBinds_async2() = - for i in 1 .. manyIterations do - tenBindAsync_async2() |> Async2.RunSynchronously -#endif - - - [] - member _.SingleSyncTask_CSharpTasks() = - for i in 1 .. manyIterations*500 do - TaskPerfCSharp.SingleSyncTask_CSharp().Wait() - - [] - member _.SingleSyncTask_taskBuilder() = - for i in 1 .. manyIterations*500 do - singleTask_taskBuilder().Wait() - - [] - member _.SingleSyncTask_async() = - for i in 1 .. manyIterations*500 do - singleTask_async() |> Async.RunSynchronously |> ignore - -#if PREVIEW - [] - member _.SingleSyncTask_task() = - for i in 1 .. manyIterations*500 do - singleTask_task().Wait() - - [] - member _.SingleSyncTask_async2() = - for i in 1 .. manyIterations*500 do - singleTask_async2() |> Async2.RunSynchronously |> ignore -#endif - - [] - member _.SyncBuilderLoop_NormalCode() = - for i in 1 .. manyIterations do - let mutable res = 0 - for i in Seq.init 1000 id do - res <- i + res - - [] - member _.SyncBuilderLoop_WorkflowCode() = - for i in 1 .. manyIterations do - sync { let mutable res = 0 - for i in Seq.init 1000 id do - res <- i + res } - -#if FSHARP_CORE_HAS_LIST_COLLECTOR - [] - member _.TinyVariableSizedList_Builtin() = Tests.ListBuilders.Examples.tinyVariableSizeBuiltin() - - - [] - member _.TinyVariableSizedList_NewBuilder() = Tests.ListBuilders.Examples.tinyVariableSizeNew() - - - [] - member _.VariableSizedList_Builtin() = Tests.ListBuilders.Examples.variableSizeBuiltin() - - [] - member _.VariableSizedList_NewBuilder() = Tests.ListBuilders.Examples.variableSizeNew() - - - [] - member _.FixedSizeList_Builtin() = Tests.ListBuilders.Examples.fixedSizeBase() - - [] - member _.FixedSizeList_NewBuilder() = Tests.ListBuilders.Examples.fixedSizeC() -#endif - - [] - member _.TinyVariableSizedArray_Builtin() = Tests.ArrayBuilders.Examples.tinyVariableSizeBuiltin() - - [] - member _.TinyVariableSizedArray_NewBuilder() = Tests.ArrayBuilders.Examples.tinyVariableSizeNew() - - - [] - member _.VariableSizedArray_Builtin() = Tests.ArrayBuilders.Examples.variableSizeBuiltin() - - [] - member _.VariableSizedArray_NewBuilder() = Tests.ArrayBuilders.Examples.variableSizeNew() - - - [] - member _.FixedSizeArray_Builtin() = Tests.ArrayBuilders.Examples.fixedSizeBase() - - - [] - member _.FixedSizeArray_NewBuilder() = Tests.ArrayBuilders.Examples.fixedSizeC() - - - [] - member _.MultiStepOption_OldBuilder() = Tests.OptionBuilders.Examples.multiStepOldBuilder() - - [] - member _.MultiStepOption_NewBuilder() = Tests.OptionBuilders.Examples.multiStepNewBuilder() - - [] - member _.MultiStepOption_NoBuilder() = Tests.OptionBuilders.Examples.multiStepNoBuilder() - - - [] - member _.MultiStepValueOption_OldBuilder() = Tests.OptionBuilders.Examples.multiStepOldBuilderV() - - [] - member _.MultiStepValueOption_NewBuilder() = Tests.OptionBuilders.Examples.multiStepNewBuilderV() - - [] - member _.MultiStepValueOption_NoBuilder() = Tests.OptionBuilders.Examples.multiStepNoBuilderV() - - -#if PREVIEW - [] - member _.NestedForLoops_CSharpAsyncEnumerable() = - TaskPerfCSharp.perf2_AsyncEnumerable() |> TaskSeq.iter ignore - - [] - member _.NestedForLoops_taskSeq() = - Tests.TaskSeq.Examples.perf2() |> TaskSeq.iter ignore - - //[] - //member _.NestedForLoops_asyncSeq() = - // Tests.TaskSeq.Examples.perf2_AsyncSeq() |> AsyncSeq.iter ignore |> Async.RunSynchronously - -#endif - -module Main = - - [] - let main argv = - let require x msg = if not x then failwith msg - printfn "Testing that the tests run..." - printfn "Running testUsing..." - let f () = - let mutable disposed = 0 - let t = - task { - use d = - { new IAsyncDisposable with - member __.DisposeAsync() = - task { - disposed <- disposed + 1 - printfn $"in disposal, disposed = {disposed}" - do! Task.Delay(10) - disposed <- disposed + 1 - printfn $"after disposal, disposed = {disposed}" - } - |> ValueTask - } - printfn $"in using, disposed = {disposed}" - do! Task.Delay(10) - } - - printfn $"outside using, disposed = {disposed}" - t.Wait() - printfn $"after full disposal, disposed = {disposed}" - - f() - - //Benchmarks().SingleSyncTask_async2() - //Benchmarks().NonAsyncBinds_async2() - //Benchmarks().ManyWriteFile_CSharpTasks() - //Benchmarks().ManyWriteFile_task () - //Benchmarks().ManyWriteFile_taskBuilder () - //Benchmarks().ManyWriteFile_FSharpAsync () - //Benchmarks().NonAsyncBinds_CSharpTasks() - //Benchmarks().NonAsyncBinds_task() - //Benchmarks().NonAsyncBinds_taskBuilder() - //Benchmarks().NonAsyncBinds_FSharpAsync() - //Benchmarks().AsyncBinds_CSharpTasks() - //Benchmarks().AsyncBinds_task() - //Benchmarks().AsyncBinds_taskBuilder() - //Benchmarks().SingleSyncTask_CSharpTasks() - //Benchmarks().SingleSyncTask_task() - //Benchmarks().SingleSyncTask_taskBuilder() - //Benchmarks().SingleSyncTask_FSharpAsync() - - //printfn "Sample t1..." - //Tests.akSeqBuilder.Examples.t1() |> TaskSeq.iter (printfn "t1(): %s") - //printfn "Sample t2..." - //Tests.TaskSeqBuilder.Examples.t2() |> TaskSeq.iter (printfn "t2(): %s") - //printfn "Sample perf1(2)..." - //Tests.TaskSeqBuilder.Examples.perf1(2) |> TaskSeq.iter (printfn "perf1(2): %d") - //printfn "Sample perf1(3)..." - //Tests.TaskSeqBuilder.Examples.perf1(3) |> TaskSeq.iter (printfn "perf1(3): %d") - //printfn "Sample perf2..." - //Tests.TaskSeqBuilder.Examples.perf2() |> TaskSeq.iter (printfn "perf2: %d") - - //Tests.TaskSeq.Examples.perf2_AsyncSeq() |> AsyncSeq.toArrayAsync |> Async.RunSynchronously |> Array.sum |> (printf "%d."); printfn "" - //Tests.TaskSeq.Examples.perf2() |> TaskSeq.toArray |> Array.sum |> (printfn "%d.") - //TaskPerfCSharp.perf2_AsyncEnumerable() |> TaskSeq.toArray |> Array.sum |> (printfn "%d.") - - printfn "Running benchmarks..." - let results = BenchmarkRunner.Run() - 0 \ No newline at end of file diff --git a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/TaskPerf.fsproj b/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/TaskPerf.fsproj deleted file mode 100644 index 31d404fb061..00000000000 --- a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/TaskPerf.fsproj +++ /dev/null @@ -1,36 +0,0 @@ - - - - $(FSharpNetCoreProductTargetFramework) - Exe - true - - $(OtherFlags) --nowarn:1204 - - $(OtherFlags) --nowarn:57 - - - $(OtherFlags) --nowarn:3511 --nowarn:3513 - $(OtherFlags) --langversion:preview - $(OtherFlags) --define:PREVIEW - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/array.fs b/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/array.fs deleted file mode 100644 index 8c1409f1233..00000000000 --- a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/array.fs +++ /dev/null @@ -1,192 +0,0 @@ - -module Tests.ArrayBuilders - -open System -open System.Collections.Generic - -[] -module UsingInlinedCodeAndCollector = - - [] - type ArrayBuilderCollector<'T> = - [] - val mutable Result : ResizeArray<'T> - - member sm.Yield (value: 'T) = - match sm.Result with - | null -> - let ra = ResizeArray() - sm.Result <- ra - ra.Add(value) - | ra -> ra.Add(value) - - member sm.ToResizeArray() = - match sm.Result with - | null -> ResizeArray() - | ra -> ra - - member sm.ToArray() = - match sm.Result with - | null -> Array.empty - | ra -> ra.ToArray() - - type ArrayBuilderCode<'T> = delegate of byref> -> unit - - type ArrayBuilderViaCollector() = - - member inline _.Delay([] f: unit -> ArrayBuilderCode<'T>) : ArrayBuilderCode<'T> = - ArrayBuilderCode<_>(fun sm -> (f()).Invoke &sm) - - member inline _.Zero() : ArrayBuilderCode<'T> = - ArrayBuilderCode<_>(fun _sm -> ()) - - member inline _.Combine([] part1: ArrayBuilderCode<'T>, [] part2: ArrayBuilderCode<'T>) : ArrayBuilderCode<'T> = - ArrayBuilderCode<_>(fun sm -> - part1.Invoke &sm - part2.Invoke &sm) - - member inline _.While([] condition : unit -> bool, [] body : ArrayBuilderCode<'T>) : ArrayBuilderCode<'T> = - ArrayBuilderCode<_>(fun sm -> - while condition() do - body.Invoke &sm) - - member inline _.TryWith([] body: ArrayBuilderCode<'T>, [] handler: exn -> ArrayBuilderCode<'T>) : ArrayBuilderCode<'T> = - ArrayBuilderCode<_>(fun sm -> - try - body.Invoke &sm - with exn -> - (handler exn).Invoke &sm) - - member inline _.TryFinally([] body: ArrayBuilderCode<'T>, compensation : unit -> unit) : ArrayBuilderCode<'T> = - ArrayBuilderCode<_>(fun sm -> - try - body.Invoke &sm - with _ -> - compensation() - reraise() - - compensation()) - - member inline b.Using(disp : #IDisposable, [] body: #IDisposable -> ArrayBuilderCode<'T>) : ArrayBuilderCode<'T> = - // A using statement is just a try/finally with the finally block disposing if non-null. - b.TryFinally( - (fun sm -> (body disp).Invoke &sm), - (fun () -> if not (isNull (box disp)) then disp.Dispose())) - - member inline b.For(sequence: seq<'TElement>, [] body: 'TElement -> ArrayBuilderCode<'T>) : ArrayBuilderCode<'T> = - b.Using (sequence.GetEnumerator(), - (fun e -> b.While((fun () -> e.MoveNext()), (fun sm -> (body e.Current).Invoke &sm)))) - - member inline _.Yield (v: 'T) : ArrayBuilderCode<'T> = - ArrayBuilderCode<_>(fun sm -> - sm.Yield v) - - member inline b.YieldFrom (source: IEnumerable<'T>) : ArrayBuilderCode<'T> = - b.For(source, (fun value -> b.Yield(value))) - - member inline _.Run([] code: ArrayBuilderCode<'T>) : 'T[] = - let mutable sm = ArrayBuilderCollector<'T>() - code.Invoke &sm - sm.ToArray() - - let arrayNew = ArrayBuilderViaCollector() - -module Examples = - - let tinyVariableSizeNew () = - for i in 1 .. 1000000 do - arrayNew { - if i % 3 = 0 then - yield "b" - } |> Array.length |> ignore - - let tinyVariableSizeBuiltin () = - for i in 1 .. 1000000 do - [| - if i % 3 = 0 then - yield "b" - |] |> Array.length |> ignore - - let variableSizeNew () = - for i in 1 .. 1000000 do - arrayNew { - yield "a" - yield "b" - yield "b" - yield "b" - yield "b" - if i % 3 = 0 then - yield "b" - yield "b" - yield "b" - yield "b" - yield "c" - } |> Array.length |> ignore - - let variableSizeBuiltin () = - for i in 1 .. 1000000 do - [| - yield "a" - yield "b" - yield "b" - yield "b" - yield "b" - if i % 3 = 0 then - yield "b" - yield "b" - yield "b" - yield "b" - yield "c" - |] |> Array.length |> ignore - - let fixedSizeC () = - for i in 1 .. 1000000 do - arrayNew { - "a" - "b" - "b" - "b" - "b" - "b" - "b" - "b" - "b" - "c" - } |> Array.length |> ignore - - let fixedSizeBase () = - for i in 1 .. 1000000 do - [| - "a" - "b" - "b" - "b" - "b" - "b" - "b" - "b" - "b" - "c" - |] |> Array.length |> ignore - - let perf s f = - let t = System.Diagnostics.Stopwatch() - t.Start() - f() - t.Stop() - printfn "PERF: %s : %d" s t.ElapsedMilliseconds - - perf "tinyVariableSizeBuiltin" tinyVariableSizeBuiltin - perf "tinyVariableSizeNew " tinyVariableSizeNew - - perf "variableSizeBuiltin" variableSizeBuiltin - perf "variableSizeNew" variableSizeNew - - perf "fixedSizeBase" fixedSizeBase - perf "fixedSizeC" fixedSizeC - // let dumpSeq (t: IEnumerable<_>) = - // let e = t.GetEnumerator() - // while e.MoveNext() do - // printfn "yield %A" e.Current - // dumpSeq (t1()) - // dumpSeq (t2()) diff --git a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/async2.fs b/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/async2.fs deleted file mode 100644 index 06938716ae1..00000000000 --- a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/async2.fs +++ /dev/null @@ -1,1131 +0,0 @@ - -namespace FSharp.Control.Async2 - -open System.Runtime.CompilerServices - -#nowarn "42" -open System -open System.Threading -open System.Threading.Tasks -open FSharp.Core.CompilerServices -open FSharp.Core.CompilerServices.StateMachineHelpers - -[] -module Utils = - let verbose = false - - let inline MoveNext(x: byref<'T> when 'T :> IAsyncStateMachine) = x.MoveNext() - -[] -type Async2StateMachineData<'T>() = - [] - val mutable cancellationToken : CancellationToken - [] - val mutable result : 'T - [] - val mutable builder : AsyncTaskMethodBuilder<'T> - [] - val mutable taken : bool - //// For tailcalls using 'return!' - //[] - //val mutable tailcallTarget: IAsync2Invocation<'T> - -and IAsync2Invokable<'T> = - abstract StartImmediate: CancellationToken -> IAsync2Invocation<'T> - -and [] IAsync2Invocation<'T> = - inherit IAsyncStateMachine - //abstract TailcallTarget: IAsync2Invocation<'T> - abstract CancellationToken: CancellationToken - abstract Task: Task<'T> - -and [] - Async2<'T>() = - - // F# requires that we implement interfaces even on an abstract class - interface IAsync2Invokable<'T> with - member _.StartImmediate(ct) = failwith "abstract" - - interface IAsync2Invocation<'T> with - //member _.TailcallTarget = failwith "abstract" - member _.CancellationToken = failwith "abstract" - member _.Task = failwith "abstract" - interface IAsyncStateMachine with - member _.MoveNext() = failwith "abstract" - member _.SetStateMachine(_state) = failwith "abstract" - - member inline x.StartImmediate(ct) = (x :> IAsync2Invokable<'T>).StartImmediate(ct) - -and [] - Async2<'Machine, 'T when 'Machine :> IAsyncStateMachine and 'Machine :> IResumableStateMachine>>() = - inherit Async2<'T>() - let initialThreadId = Environment.CurrentManagedThreadId - - [] - val mutable Machine : 'Machine - - //member internal ts.hijack() = (ts :> IAsync2Invocation<_>) - //let res = ts.Machine.Data.tailcallTarget - //match res with - //| null -> (ts :> IAsync2Invocation<_>) - //| tg -> - // match (tg :> IAsync2Invocation<_>).TailcallTarget with - // | null -> - // res - // | res2 -> - // // Cut out chains of tailcalls - // ts.Machine.Data.tailcallTarget <- res2 - // res2 - - interface IAsyncStateMachine with - member ts.MoveNext() = - MoveNext(&ts.Machine) - - //match ts.hijack() with - //| null -> - //| tg -> (tg :> IAsyncStateMachine).MoveNext() - - member ts.SetStateMachine(state) = - //printfn "SetStateMachine" - () - //ts.Machine.Data.builder.SetStateMachine(state) - - interface IAsync2Invokable<'T> with - member ts.StartImmediate(ct) = - let data = ts.Machine.Data - if (not data.taken && initialThreadId = Environment.CurrentManagedThreadId) then - data.taken <- true - data.cancellationToken <- ct - //printfn "creating" - data.builder <- AsyncTaskMethodBuilder<'T>.Create() - //printfn "starting" - data.builder.Start(&ts.Machine) - (ts :> IAsync2Invocation<_>) - else - let clone = ts.MemberwiseClone() :?> Async2<'Machine, 'T> - data.taken <- true - clone.Machine.Data.cancellationToken <- ct - clone.Machine.MoveNext() - (clone :> IAsync2Invocation<'T>) - - interface IAsync2Invocation<'T> with - member ts.CancellationToken = ts.Machine.Data.cancellationToken - member ts.Task = ts.Machine.Data.builder.Task - //member ts.TailcallTarget = ts.hijack() - -and Async2Code<'TOverall, 'T> = ResumableCode, 'T> -and Async2StateMachine<'T> = ResumableStateMachine> -and Async2ResumptionFunc<'T> = ResumptionFunc> -and Async2ResumptionDynamicInfo<'T> = ResumptionDynamicInfo> - -[] -type Async2Builder() = - - member inline _.Delay(f : unit -> Async2Code<'TOverall, 'T>) : Async2Code<'TOverall, 'T> = - Async2Code<'TOverall, 'T>(fun sm -> f().Invoke(&sm)) - - member inline _.Run(code : Async2Code<'T, 'T>) : Async2<'T> = - if __useResumableCode then - // This is the static implementation. A new struct type is created. - __stateMachine, Async2<'T>> - (MoveNextMethodImpl<_>(fun sm -> - //-- RESUMABLE CODE START - __resumeAt sm.ResumptionPoint - try - //printfn "at Run.MoveNext start" - //Console.WriteLine("[{0}] resuming by invoking {1}....", sm.MethodBuilder.Task.Id, hashq sm.ResumptionFunc ) - let __stack_code_fin = code.Invoke(&sm) - //printfn $"at Run.MoveNext, __stack_code_fin={__stack_code_fin}" - if __stack_code_fin then - //printfn $"at Run.MoveNext, done" - sm.Data.builder.SetResult(sm.Data.result) - - with exn -> - //Console.WriteLine("[{0}] SetException {1}", sm.MethodBuilder.Task.Id, exn) - sm.Data.builder.SetException(exn) - - //// tailcall - //match sm.Data.tailcallTarget with - //| null -> - // printfn $"at Run.MoveNext, await" - //| tg -> - // printfn $"at Run.MoveNext, hijack" - // let mutable tg = tg - // MoveNext(&tg) - //-- RESUMABLE CODE END - )) - (SetStateMachineMethodImpl<_>(fun sm state -> ())) - (AfterCode<_,_>(fun sm -> - let ts = Async2, 'T>() - ts.Machine <- sm - ts.Machine.Data <- Async2StateMachineData() - ts :> Async2<'T>)) - else - failwith "no dynamic implementation as yet" - // let initialResumptionFunc = Async2ResumptionFunc<'T>(fun sm -> code.Invoke(&sm)) - // let resumptionFuncExecutor = Async2ResumptionExecutor<'T>(fun sm f -> - // // TODO: add exception handling? - // if f.Invoke(&sm) then - // sm.ResumptionPoint <- -2) - // let setStateMachine = SetStateMachineMethodImpl<_>(fun sm f -> ()) - // sm.Machine.ResumptionFuncInfo <- (initialResumptionFunc, resumptionFuncExecutor, setStateMachine) - //sm.Start() - - - [] - member inline _.Zero() : Async2Code<'TOverall, unit> = - ResumableCode.Zero() - - member inline _.Combine(task1: Async2Code<'TOverall, unit>, task2: Async2Code<'TOverall, 'T>) : Async2Code<'TOverall, 'T> = - ResumableCode.Combine(task1, task2) - - member inline _.WhileAsync([] condition : unit -> ValueTask, body : Async2Code<'TOverall, unit>) : Async2Code<'TOverall, unit> = - let mutable condition_res = true - ResumableCode.While((fun () -> condition_res), - ResumableCode<_,_>(fun sm -> - let mutable __stack_condition_fin = true - let __stack_vtask = condition() - if __stack_vtask.IsCompleted then - __stack_condition_fin <- true - condition_res <- __stack_vtask.Result - else - let task = __stack_vtask.AsTask() - let mutable awaiter = task.GetAwaiter() - // This will yield with __stack_fin = false - // This will resume with __stack_fin = true - let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) - __stack_condition_fin <- __stack_yield_fin - - if __stack_condition_fin then - condition_res <- task.Result - else - sm.Data.builder.AwaitUnsafeOnCompleted(&awaiter, &sm) - - if __stack_condition_fin then - if condition_res then - body.Invoke(&sm) - else - true - else - false - )) - - member inline _.While([] condition : unit -> bool, body : Async2Code<'TOverall, unit>) : Async2Code<'TOverall, unit> = - ResumableCode.While(condition, body) - - member inline _.TryWith(body : Async2Code<'TOverall, 'T>, catch : exn -> Async2Code<'TOverall, 'T>) : Async2Code<'TOverall, 'T> = - ResumableCode.TryWith(body, catch) - - member inline internal _.TryFinallyAsync(body: Async2Code<'TOverall, 'T>, compensation : unit -> Task) : Async2Code<'TOverall, 'T> = - ResumableCode.TryFinallyAsync(body, ResumableCode<_,_>(fun sm -> - let mutable __stack_condition_fin = true - let __stack_vtask = compensation() - if not __stack_vtask.IsCompleted then - let mutable awaiter = __stack_vtask.GetAwaiter() - let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) - __stack_condition_fin <- __stack_yield_fin - - if not __stack_condition_fin then - sm.Data.builder.AwaitUnsafeOnCompleted(&awaiter, &sm) - - __stack_condition_fin)) - - member inline _.TryFinally(body: Async2Code<'TOverall, 'T>, compensation : unit -> unit) : Async2Code<'TOverall, 'T> = - ResumableCode.TryFinally(body, ResumableCode<_,_>(fun sm -> compensation(); true)) - - member inline this.Using(resource : #IAsyncDisposable, body : #IAsyncDisposable -> Async2Code<'TOverall, 'T>) : Async2Code<'TOverall, 'T> = - // A using statement is just a try/finally with the finally block disposing if non-null. - this.TryFinallyAsync( - (fun sm -> (body resource).Invoke(&sm)), - (fun () -> - if not (isNull (box resource)) then - resource.DisposeAsync().AsTask() - else - Task.CompletedTask)) - - member inline _.Return (v: 'T) : Async2Code<'T, 'T> = - Async2Code<'T, 'T>(fun sm -> - sm.Data.result <- v - true) - - member inline _.Bind (task: Task<'TResult1>, continuation: ('TResult1 -> Async2Code<'TOverall, 'T>)) : Async2Code<'TOverall, 'T> = - Async2Code<'TOverall, 'T>(fun sm -> - let mutable awaiter = task.GetAwaiter() - let mutable __stack_fin = true - if not awaiter.IsCompleted then - // This will yield with __stack_fin2 = false - // This will resume with __stack_fin2 = true - let __stack_fin2 = ResumableCode.Yield().Invoke(&sm) - __stack_fin <- __stack_fin2 - - if __stack_fin then - let result = awaiter.GetResult() - (continuation result).Invoke(&sm) - else - sm.Data.builder.AwaitUnsafeOnCompleted(&awaiter, &sm) - false) - - member inline b.Bind (computation: Async2<'TResult1>, continuation: ('TResult1 -> Async2Code<'TOverall, 'T>)) : Async2Code<'TOverall, 'T> = - Async2Code<'TOverall, 'T>(fun sm -> - let ct = sm.Data.cancellationToken - b.Bind(computation.StartImmediate(ct).Task, continuation).Invoke(&sm)) - - member inline b.Bind (computation: Async<'TResult1>, continuation: ('TResult1 -> Async2Code<'TOverall, 'T>)) : Async2Code<'TOverall, 'T> = - Async2Code<'TOverall, 'T>(fun sm -> - let ct = sm.Data.cancellationToken - b.Bind(Async.StartImmediateAsTask(computation, ct), continuation).Invoke(&sm)) - - member inline b.ReturnFrom (task: Task<'T>) : Async2Code<'T, 'T> = - // No tailcalling to tasks - b.Bind(task, (fun res -> b.Return(res))) - - member inline b.ReturnFrom (computation: Async<'T>) : Async2Code<'T, 'T> = - // No tailcalling to Async - b.Bind(computation, (fun res -> b.Return(res))) - -// TODO - implement RFC for ReturnFromTailcall to make this safe - member inline b.ReturnFrom (other: Async2<'T>) : Async2Code<'T, 'T> = - b.Bind(other, (fun res -> b.Return(res))) - //Async2Code<'T, _>(fun sm -> - // printfn "setting hijack target and starting" - // sm.Data.tailcallTarget <- other - // // For tailcalls we return 'false' and re-run from the entry (trampoline) - // false - //) - - - -[] -module Async2 = - type Async2Builder with - member inline this.Using(resource : ('TResource :> IDisposable), body : ('TResource -> Async2Code<'TOverall, 'T>)) : Async2Code<'TOverall, 'T> = - // A using statement is just a try/finally with the finally block disposing if non-null. - this.TryFinally( - (fun sm -> (body resource).Invoke(&sm)), - (fun () -> if not (isNull (box resource)) then resource.Dispose())) - - member inline _.Bind< ^TaskLike, ^TResult1, 'TResult2, ^Awaiter , 'TOverall - when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) - and ^Awaiter :> ICriticalNotifyCompletion - and ^Awaiter: (member get_IsCompleted: unit -> bool) - and ^Awaiter: (member GetResult: unit -> ^TResult1)> - (task: ^TaskLike, continuation: (^TResult1 -> Async2Code<'TOverall, 'TResult2>)) : Async2Code<'TOverall, 'TResult2> = - - Async2Code<'TOverall, 'TResult2>(fun sm -> - if __useResumableCode then - //-- RESUMABLE CODE START - // Get an awaiter from the awaitable - let mutable awaiter = (^TaskLike: (member GetAwaiter : unit -> ^Awaiter)(task)) - - let mutable __stack_fin = true - if not (^Awaiter : (member get_IsCompleted : unit -> bool)(awaiter)) then - // This will yield with __stack_yield_fin = false - // This will resume with __stack_yield_fin = true - let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) - __stack_fin <- __stack_yield_fin - - if __stack_fin then - let result = (^Awaiter : (member GetResult : unit -> ^TResult1)(awaiter)) - (continuation result).Invoke(&sm) - else - sm.Data.builder.AwaitUnsafeOnCompleted(&awaiter, &sm) - false - else - failwith "dynamic" //TaskWitnesses.CanBindDynamic< ^TaskLike, ^TResult1, 'TResult2, ^Awaiter , 'TOverall>(&sm, priority, task, continuation) - //-- RESUMABLE CODE END - ) - - member inline b.ReturnFrom< ^TaskLike, ^Awaiter, ^T - when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) - and ^Awaiter :> ICriticalNotifyCompletion - and ^Awaiter: (member get_IsCompleted: unit -> bool) - and ^Awaiter: (member GetResult: unit -> ^T)> - (task: ^TaskLike) : Async2Code< ^T, ^T> = - b.Bind(task, (fun res -> b.Return(res))) - - member inline this.For(sequence : seq<'TElement>, body : 'TElement -> Async2Code<'TOverall, unit>) : Async2Code<'TOverall, unit> = - // A for loop is just a using statement on the sequence's enumerator... - this.Using (sequence.GetEnumerator(), - // ... and its body is a while loop that advances the enumerator and runs the body on each element. - (fun e -> this.While((fun () -> e.MoveNext()), (fun sm -> (body e.Current).Invoke(&sm))))) - - let async2 = Async2Builder() - - let runSynchronously ct (t: Async2<'T>) = - let e = t.StartImmediate(ct) - e.Task.Result - - let cancellationTokenAsync = - async2.Run(Async2Code(fun sm -> - sm.Data.result <- sm.Data.cancellationToken - true)) - - let unitAsync = async2 { return () } - -[] -type Async2 = - - static member CancellationToken = cancellationTokenAsync - - static member CancelCheck () = unitAsync - - static member DefaultCancellationToken = Async.DefaultCancellationToken - - static member CancelDefaultToken() = Async.CancelDefaultToken() - - static member Catch (computation: Async2<'T>) = - async2 { try let! res = computation in return Choice1Of2 res with e -> return Choice2Of2 e } - - static member RunSynchronously (computation: Async2<'T>, ?timeout: int, ?cancellationToken:CancellationToken) = - // TODO: timeout - let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken - let e = computation.StartImmediate(cancellationToken) - e.Task.Result - - static member StartImmediateAsTask (computation: Async2<'T>, ?cancellationToken ) : Task<'T> = - let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken - let e = computation.StartImmediate(cancellationToken) - e.Task - - static member StartImmediate(computation:Async2, ?cancellationToken) : unit = - let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken - let e = computation.StartImmediate(cancellationToken) - e |> ignore - - static member SwitchToNewThread() = - async2 { return! Task.CompletedTask.ConfigureAwait(false) } - - static member SwitchToThreadPool() : Async2 = - async2 { return! Task.CompletedTask.ConfigureAwait(false) } - - static member Start (computation: Async2, ?cancellationToken) = - let p = - async2 { - do! Async2.SwitchToThreadPool() - return! computation - } - Async2.StartImmediate(p, ?cancellationToken=cancellationToken) - - static member StartAsTask (computation: Async2<'T>, ?taskCreationOptions: TaskCreationOptions, ?cancellationToken) = - // TODO: taskCreationOptions - let p = - async2 { - do! Async2.SwitchToThreadPool() - return! computation - } - Async2.StartImmediateAsTask(p, ?cancellationToken=cancellationToken) - - static member StartChildAsTask (computation: Async2<'T>, ?taskCreationOptions) : Async2> = - async2 { - let! cancellationToken = cancellationTokenAsync - return Async2.StartAsTask (computation, ?taskCreationOptions=taskCreationOptions, cancellationToken=cancellationToken) - } - - - static member Sleep (millisecondsDueTime: int64) : Async2 = - // TODO: int64 millisecondsDueTime? - async2 { return! Task.Delay(int millisecondsDueTime)} - - static member Sleep (millisecondsDueTime: int32) : Async2 = - async2 { return! Task.Delay(millisecondsDueTime)} - - static member Sleep (dueTime: TimeSpan) = - async2 { return! Task.Delay(dueTime)} - - static member Ignore (computation: Async2<'T>) = - async2 { let! _res = computation in return () } - - static member AwaitTask (task:Task<'T>) : Async2<'T> = - async2 { return! task } - - static member AwaitTask (task:Task) : Async2 = - async2 { return! task } - - //static member FromContinuations (callback: ('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) : Async2<'T> = - // MakeAsync (fun ctxt -> - // if ctxt.IsCancellationRequested then - // ctxt.OnCancellation () - // else - // let mutable underCurrentThreadStack = true - // let mutable contToTailCall = None - // let thread = Thread.CurrentThread - // let latch = Latch() - // let once cont x = - // if not(latch.Enter()) then invalidOp(SR.GetString(SR.controlContinuationInvokedMultipleTimes)) - // if Thread.CurrentThread.Equals thread && underCurrentThreadStack then - // contToTailCall <- Some(fun () -> cont x) - // else if Trampoline.ThisThreadHasTrampoline then - // let syncCtxt = SynchronizationContext.Current - // ctxt.trampolineHolder.PostOrQueueWithTrampoline syncCtxt (fun () -> cont x) |> unfake - // else - // ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> cont x ) |> unfake - // try - // callback (once ctxt.cont, (fun exn -> once ctxt.econt (ExceptionDispatchInfo.RestoreOrCapture exn)), once ctxt.ccont) - // with exn -> - // if not(latch.Enter()) then invalidOp(SR.GetString(SR.controlContinuationInvokedMultipleTimes)) - // let edi = ExceptionDispatchInfo.RestoreOrCapture exn - // ctxt.econt edi |> unfake - - // underCurrentThreadStack <- false - - // match contToTailCall with - // | Some k -> k() - // | _ -> fake()) - - //static member Parallel (computations: seq>) = Async.Parallel(computations, ?maxDegreeOfParallelism=None) - - //static member Parallel (computations: seq>, ?maxDegreeOfParallelism: int) = - // match maxDegreeOfParallelism with - // | Some x when x < 1 -> raise(System.ArgumentException(String.Format(SR.GetString(SR.maxDegreeOfParallelismNotPositive), x), "maxDegreeOfParallelism")) - // | _ -> () - - // MakeAsync (fun ctxt -> - // let tasks, result = - // try - // Seq.toArray computations, None // manually protect eval of seq - // with exn -> - // let edi = ExceptionDispatchInfo.RestoreOrCapture exn - // null, Some (ctxt.econt edi) - - // match result with - // | Some r -> r - // | None -> - // if tasks.Length = 0 then - // // must not be in a 'protect' if we call cont explicitly; if cont throws, it should unwind the stack, preserving Dev10 behavior - // ctxt.cont [| |] - // else - // ProtectedCode ctxt (fun ctxt -> - // let ctxtWithSync = DelimitSyncContext ctxt // manually resync - // let mutable count = tasks.Length - // let mutable firstExn = None - // let results = Array.zeroCreate tasks.Length - // // Attempt to cancel the individual operations if an exception happens on any of the other threads - // let innerCTS = new LinkedSubSource(ctxtWithSync.token) - - // let finishTask remaining = - // if (remaining = 0) then - // innerCTS.Dispose() - // match firstExn with - // | None -> ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont results) - // | Some (Choice1Of2 exn) -> ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.econt exn) - // | Some (Choice2Of2 cexn) -> ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.ccont cexn) - // else - // fake() - - // // recordSuccess and recordFailure between them decrement count to 0 and - // // as soon as 0 is reached dispose innerCancellationSource - - // let recordSuccess i res = - // results.[i] <- res - // finishTask(Interlocked.Decrement &count) - - // let recordFailure exn = - // // capture first exception and then decrement the counter to avoid race when - // // - thread 1 decremented counter and preempted by the scheduler - // // - thread 2 decremented counter and called finishTask - // // since exception is not yet captured - finishtask will fall into success branch - // match Interlocked.CompareExchange(&firstExn, Some exn, None) with - // | None -> - // // signal cancellation before decrementing the counter - this guarantees that no other thread can sneak to finishTask and dispose innerCTS - // // NOTE: Cancel may introduce reentrancy - i.e. when handler registered for the cancellation token invokes cancel continuation that will call 'recordFailure' - // // to correctly handle this we need to return decremented value, not the current value of 'count' otherwise we may invoke finishTask with value '0' several times - // innerCTS.Cancel() - // | _ -> () - // finishTask(Interlocked.Decrement &count) - - // // If maxDegreeOfParallelism is set but is higher then the number of tasks we have we set it back to None to fall into the simple - // // queue all items branch - // let maxDegreeOfParallelism = - // match maxDegreeOfParallelism with - // | None -> None - // | Some x when x >= tasks.Length -> None - // | Some _ as x -> x - - // // Simple case (no maxDegreeOfParallelism) just queue all the work, if we have maxDegreeOfParallelism set we start that many workers - // // which will make progress on the actual computations - // match maxDegreeOfParallelism with - // | None -> - // tasks |> Array.iteri (fun i p -> - // QueueAsync - // innerCTS.Token - // // on success, record the result - // (fun res -> recordSuccess i res) - // // on exception... - // (fun edi -> recordFailure (Choice1Of2 edi)) - // // on cancellation... - // (fun cexn -> recordFailure (Choice2Of2 cexn)) - // p - // |> unfake) - // | Some maxDegreeOfParallelism -> - // let mutable i = -1 - // let rec worker (trampolineHolder : TrampolineHolder) = - // if i < tasks.Length then - // let j = Interlocked.Increment &i - // if j < tasks.Length then - // if innerCTS.Token.IsCancellationRequested then - // let cexn = OperationCanceledException (innerCTS.Token) - // recordFailure (Choice2Of2 cexn) |> unfake - // worker trampolineHolder |> unfake - // else - // let taskCtxt = - // AsyncActivation.Create - // innerCTS.Token - // trampolineHolder - // (fun res -> recordSuccess j res |> unfake; worker trampolineHolder) - // (fun edi -> recordFailure (Choice1Of2 edi) |> unfake; worker trampolineHolder) - // (fun cexn -> recordFailure (Choice2Of2 cexn) |> unfake; worker trampolineHolder) - // tasks.[j].Invoke taskCtxt |> unfake - // fake() - // for x = 1 to maxDegreeOfParallelism do - // let trampolineHolder = TrampolineHolder() - // trampolineHolder.QueueWorkItemWithTrampoline (fun () -> - // worker trampolineHolder) - // |> unfake - - // fake())) - - //static member Sequential (computations: seq>) = Async.Parallel(computations, maxDegreeOfParallelism=1) - - //static member Choice(computations: Async2<'T option> seq) : Async2<'T option> = - // MakeAsync (fun ctxt -> - // let result = - // try Seq.toArray computations |> Choice1Of2 - // with exn -> ExceptionDispatchInfo.RestoreOrCapture exn |> Choice2Of2 - - // match result with - // | Choice2Of2 edi -> ctxt.econt edi - // | Choice1Of2 [||] -> ctxt.cont None - // | Choice1Of2 computations -> - // ProtectedCode ctxt (fun ctxt -> - // let ctxtWithSync = DelimitSyncContext ctxt - // let mutable count = computations.Length - // let mutable noneCount = 0 - // let mutable someOrExnCount = 0 - // let innerCts = new LinkedSubSource(ctxtWithSync.token) - - // let scont (result: 'T option) = - // let result = - // match result with - // | Some _ -> - // if Interlocked.Increment &someOrExnCount = 1 then - // innerCts.Cancel(); ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont result) - // else - // fake() - - // | None -> - // if Interlocked.Increment &noneCount = computations.Length then - // innerCts.Cancel(); ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.cont None) - // else - // fake() - - // if Interlocked.Decrement &count = 0 then - // innerCts.Dispose() - - // result - - // let econt (exn: ExceptionDispatchInfo) = - // let result = - // if Interlocked.Increment &someOrExnCount = 1 then - // innerCts.Cancel(); ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.econt exn) - // else - // fake() - - // if Interlocked.Decrement &count = 0 then - // innerCts.Dispose() - - // result - - // let ccont (exn: OperationCanceledException) = - // let result = - // if Interlocked.Increment &someOrExnCount = 1 then - // innerCts.Cancel(); ctxtWithSync.trampolineHolder.ExecuteWithTrampoline (fun () -> ctxtWithSync.ccont exn) - // else - // fake() - - // if Interlocked.Decrement &count = 0 then - // innerCts.Dispose() - - // result - - // for c in computations do - // QueueAsync innerCts.Token scont econt ccont c |> unfake - - // fake())) - - /// StartWithContinuations, except the exception continuation is given an ExceptionDispatchInfo - //static member StartWithContinuationsUsingDispatchInfo(computation:Async2<'T>, continuation, exceptionContinuation, cancellationContinuation, ?cancellationToken) : unit = - // let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken - // AsyncPrimitives.StartWithContinuations cancellationToken computation continuation exceptionContinuation cancellationContinuation - - //static member StartWithContinuations(computation:Async2<'T>, continuation, exceptionContinuation, cancellationContinuation, ?cancellationToken) : unit = - // Async.StartWithContinuationsUsingDispatchInfo(computation, continuation, (fun edi -> exceptionContinuation (edi.GetAssociatedSourceException())), cancellationContinuation, ?cancellationToken=cancellationToken) - - ///// Wait for a wait handle. Both timeout and cancellation are supported - //static member AwaitWaitHandle(waitHandle: WaitHandle, ?millisecondsTimeout:int) = - // let millisecondsTimeout = defaultArg millisecondsTimeout Threading.Timeout.Infinite - // if millisecondsTimeout = 0 then - // async.Delay(fun () -> - // let ok = waitHandle.WaitOne(0, exitContext=false) - // async.Return ok) - // else - // CreateDelimitedUserCodeAsync(fun ctxt -> - // let aux = ctxt.aux - // let rwh = ref (None: RegisteredWaitHandle option) - // let latch = Latch() - // let rec cancelHandler = - // Action(fun () -> - // if latch.Enter() then - // // if we got here - then we need to unregister RegisteredWaitHandle + trigger cancellation - // // entrance to TP callback is protected by latch - so savedCont will never be called - // lock rwh (fun () -> - // match !rwh with - // | None -> () - // | Some rwh -> rwh.Unregister null |> ignore) - // Async.Start (async2 { do (ctxt.ccont (OperationCanceledException(aux.token)) |> unfake) })) - - // and registration: CancellationTokenRegistration = aux.token.Register(cancelHandler) - - // let savedCont = ctxt.cont - // try - // lock rwh (fun () -> - // rwh := Some(ThreadPool.RegisterWaitForSingleObject - // (waitObject=waitHandle, - // callBack=WaitOrTimerCallback(fun _ timeOut -> - // if latch.Enter() then - // lock rwh (fun () -> rwh.Value.Value.Unregister null |> ignore) - // rwh := None - // registration.Dispose() - // ctxt.trampolineHolder.ExecuteWithTrampoline (fun () -> savedCont (not timeOut)) |> unfake), - // state=null, - // millisecondsTimeOutInterval=millisecondsTimeout, - // executeOnlyOnce=true)) - // fake()) - // with _ -> - // if latch.Enter() then - // registration.Dispose() - // reraise() // reraise exception only if we successfully enter the latch (no other continuations were called) - // else - // fake() - // ) - - //static member AwaitIAsyncResult(iar: IAsyncResult, ?millisecondsTimeout): Async2 = - // async2 { if iar.CompletedSynchronously then - // return true - // else - // return! Async.AwaitWaitHandle(iar.AsyncWaitHandle, ?millisecondsTimeout=millisecondsTimeout) } - - - ///// Bind the result of a result cell, calling the appropriate continuation. - //static member BindResult (result: AsyncResult<'T>) : Async2<'T> = - // MakeAsync (fun ctxt -> - // (match result with - // | Ok v -> ctxt.cont v - // | Error exn -> ctxt.econt exn - // | Canceled exn -> ctxt.ccont exn) ) - - ///// Await and use the result of a result cell. The resulting async doesn't support cancellation - ///// or timeout directly, rather the underlying computation must fill the result if cancellation - ///// or timeout occurs. - //static member AwaitAndBindResult_NoDirectCancelOrTimeout(resultCell: ResultCell>) : Async2<'T> = - // async2 { - // let! result = resultCell.AwaitResult_NoDirectCancelOrTimeout - // return! Async.BindResult result - // } - - ///// Await the result of a result cell belonging to a child computation. The resulting async supports timeout and if - ///// it happens the child computation will be cancelled. The resulting async doesn't support cancellation - ///// directly, rather the underlying computation must fill the result if cancellation occurs. - //static member AwaitAndBindChildResult(innerCTS: CancellationTokenSource, resultCell: ResultCell>, millisecondsTimeout) : Async2<'T> = - // match millisecondsTimeout with - // | None | Some -1 -> - // resultCell |> Async.AwaitAndBindResult_NoDirectCancelOrTimeout - - // | Some 0 -> - // async2 { if resultCell.ResultAvailable then - // let res = resultCell.GrabResult() - // return res.Commit() - // else - // return raise (System.TimeoutException()) } - // | _ -> - // async2 { try - // if resultCell.ResultAvailable then - // let res = resultCell.GrabResult() - // return res.Commit() - // else - // let! ok = Async.AwaitWaitHandle (resultCell.GetWaitHandle(), ?millisecondsTimeout=millisecondsTimeout) - // if ok then - // let res = resultCell.GrabResult() - // return res.Commit() - // else // timed out - // // issue cancellation signal - // innerCTS.Cancel() - // // wait for computation to quiesce - // let! _ = Async.AwaitWaitHandle (resultCell.GetWaitHandle()) - // return raise (System.TimeoutException()) - // finally - // resultCell.Close() } - - - //static member FromBeginEnd(beginAction, endAction, ?cancelAction): Async2<'T> = - // async2 { let! cancellationToken = cancellationTokenAsync - // let resultCell = new ResultCell<_>() - - // let once = Once() - - // let registration: CancellationTokenRegistration = - - // let onCancel () = - // // Call the cancellation routine - // match cancelAction with - // | None -> - // // Register the result. This may race with a successful result, but - // // ResultCell allows a race and throws away whichever comes last. - // once.Do(fun () -> - // let canceledResult = Canceled (OperationCanceledException cancellationToken) - // resultCell.RegisterResult(canceledResult, reuseThread=true) |> unfake - // ) - // | Some cancel -> - // // If we get an exception from a cooperative cancellation function - // // we assume the operation has already completed. - // try cancel() with _ -> () - - // cancellationToken.Register(Action(onCancel)) - - // let callback = - // System.AsyncCallback(fun iar -> - // if not iar.CompletedSynchronously then - // // The callback has been activated, so ensure cancellation is not possible - // // beyond this point. - // match cancelAction with - // | Some _ -> - // registration.Dispose() - // | None -> - // once.Do(fun () -> registration.Dispose()) - - // // Run the endAction and collect its result. - // let res = - // try - // Ok(endAction iar) - // with exn -> - // let edi = ExceptionDispatchInfo.RestoreOrCapture exn - // Error edi - - // // Register the result. This may race with a cancellation result, but - // // ResultCell allows a race and throws away whichever comes last. - // resultCell.RegisterResult(res, reuseThread=true) |> unfake) - - // let (iar:IAsyncResult) = beginAction (callback, (null:obj)) - // if iar.CompletedSynchronously then - // registration.Dispose() - // return endAction iar - // else - // // Note: ok to use "NoDirectCancel" here because cancellation has been registered above - // // Note: ok to use "NoDirectTimeout" here because no timeout parameter to this method - // return! Async.AwaitAndBindResult_NoDirectCancelOrTimeout resultCell } - - - //static member FromBeginEnd(arg, beginAction, endAction, ?cancelAction): Async2<'T> = - // Async.FromBeginEnd((fun (iar, state) -> beginAction(arg, iar, state)), endAction, ?cancelAction=cancelAction) - - //static member FromBeginEnd(arg1, arg2, beginAction, endAction, ?cancelAction): Async2<'T> = - // Async.FromBeginEnd((fun (iar, state) -> beginAction(arg1, arg2, iar, state)), endAction, ?cancelAction=cancelAction) - - //static member FromBeginEnd(arg1, arg2, arg3, beginAction, endAction, ?cancelAction): Async2<'T> = - // Async.FromBeginEnd((fun (iar, state) -> beginAction(arg1, arg2, arg3, iar, state)), endAction, ?cancelAction=cancelAction) - - //static member AsBeginEnd<'Arg, 'T> (computation:('Arg -> Async2<'T>)) : - // // The 'Begin' member - // ('Arg * System.AsyncCallback * obj -> System.IAsyncResult) * - // // The 'End' member - // (System.IAsyncResult -> 'T) * - // // The 'Cancel' member - // (System.IAsyncResult -> unit) = - // let beginAction = fun (a1, callback, state) -> AsBeginEndHelpers.beginAction ((computation a1), callback, state) - // beginAction, AsBeginEndHelpers.endAction<'T>, AsBeginEndHelpers.cancelAction<'T> - - //static member AwaitEvent(event:IEvent<'Delegate, 'T>, ?cancelAction) : Async2<'T> = - // async2 { let! cancellationToken = cancellationTokenAsync - // let resultCell = new ResultCell<_>() - // // Set up the handlers to listen to events and cancellation - // let once = Once() - // let rec registration: CancellationTokenRegistration= - // let onCancel () = - // // We've been cancelled. Call the given cancellation routine - // match cancelAction with - // | None -> - // // We've been cancelled without a cancel action. Stop listening to events - // event.RemoveHandler del - // // Register the result. This may race with a successful result, but - // // ResultCell allows a race and throws away whichever comes last. - // once.Do(fun () -> resultCell.RegisterResult(Canceled (OperationCanceledException cancellationToken), reuseThread=true) |> unfake) - // | Some cancel -> - // // If we get an exception from a cooperative cancellation function - // // we assume the operation has already completed. - // try cancel() with _ -> () - // cancellationToken.Register(Action(onCancel)) - - // and del = - // FuncDelegate<'T>.Create<'Delegate>(fun eventArgs -> - // // Stop listening to events - // event.RemoveHandler del - // // The callback has been activated, so ensure cancellation is not possible beyond this point - // once.Do(fun () -> registration.Dispose()) - // let res = Ok eventArgs - // // Register the result. This may race with a cancellation result, but - // // ResultCell allows a race and throws away whichever comes last. - // resultCell.RegisterResult(res, reuseThread=true) |> unfake) - - // // Start listening to events - // event.AddHandler del - - // // Return the async computation that allows us to await the result - // // Note: ok to use "NoDirectCancel" here because cancellation has been registered above - // // Note: ok to use "NoDirectTimeout" here because no timeout parameter to this method - // return! Async.AwaitAndBindResult_NoDirectCancelOrTimeout resultCell } - - //static member StartChild (computation:Async2<'T>, ?millisecondsTimeout) = - // async2 { - // let resultCell = new ResultCell<_>() - // let! cancellationToken = cancellationTokenAsync - // let innerCTS = new CancellationTokenSource() // innerCTS does not require disposal - // let mutable ctsRef = innerCTS - // let reg = cancellationToken.Register( - // (fun () -> - // match ctsRef with - // | null -> () - // | otherwise -> otherwise.Cancel())) - // do QueueAsync - // innerCTS.Token - // // since innerCTS is not ever Disposed, can call reg.Dispose() without a safety Latch - // (fun res -> ctsRef <- null; reg.Dispose(); resultCell.RegisterResult (Ok res, reuseThread=true)) - // (fun edi -> ctsRef <- null; reg.Dispose(); resultCell.RegisterResult (Error edi, reuseThread=true)) - // (fun err -> ctsRef <- null; reg.Dispose(); resultCell.RegisterResult (Canceled err, reuseThread=true)) - // computation - // |> unfake - - // return Async.AwaitAndBindChildResult(innerCTS, resultCell, millisecondsTimeout) } - - //static member SwitchToContext syncContext = - // let t = - // Task.Factory.StartNew( - // (fun () -> ()), // this will use current synchronization context - // CancellationToken.None, - // TaskCreationOptions.None, - // TaskScheduler. .FromCurrentSynchronizationContext()) - // async2 { match syncContext with - // | null -> - // // no synchronization context, just switch to the thread pool - // do! Async.SwitchToThreadPool() - // | syncCtxt -> - // // post the continuation to the synchronization context - // return! CreateSwitchToAsync syncCtxt } - - //static member OnCancel interruption = - // async2 { let! cancellationToken = cancellationTokenAsync - // // latch protects CancellationTokenRegistration.Dispose from being called twice - // let latch = Latch() - // let rec handler () = - // try - // if latch.Enter() then registration.Dispose() - // interruption () - // with _ -> () - // and registration: CancellationTokenRegistration = cancellationToken.Register(Action(handler)) - // return { new System.IDisposable with - // member this.Dispose() = - // // dispose CancellationTokenRegistration only if cancellation was not requested. - // // otherwise - do nothing, disposal will be performed by the handler itself - // if not cancellationToken.IsCancellationRequested then - // if latch.Enter() then registration.Dispose() } } - - //static member TryCancelled (computation: Async2<'T>, compensation) = - // CreateWhenCancelledAsync compensation computation - -//module CommonExtensions = - -// type System.IO.Stream with - -// [] // give the extension member a 'nice', unmangled compiled name, unique within this module -// member stream.AsyncRead(buffer: byte[], ?offset, ?count) = -// let offset = defaultArg offset 0 -// let count = defaultArg count buffer.Length -// Async.FromBeginEnd (buffer, offset, count, stream.BeginRead, stream.EndRead) - -// [] // give the extension member a 'nice', unmangled compiled name, unique within this module -// member stream.AsyncRead count = -// async2 { -// let buffer = Array.zeroCreate count -// let mutable i = 0 -// while i < count do -// let! n = stream.AsyncRead(buffer, i, count - i) -// i <- i + n -// if n = 0 then -// raise(System.IO.EndOfStreamException()) -// return buffer } - -// [] // give the extension member a 'nice', unmangled compiled name, unique within this module -// member stream.AsyncWrite(buffer:byte[], ?offset:int, ?count:int) = -// let offset = defaultArg offset 0 -// let count = defaultArg count buffer.Length -// Async.FromBeginEnd (buffer, offset, count, stream.BeginWrite, stream.EndWrite) - - -//module WebExtensions = - -// type System.Net.WebRequest with -// [] // give the extension member a 'nice', unmangled compiled name, unique within this module -// member req.AsyncGetResponse() : Async2 = - -// let mutable canceled = false // WebException with Status = WebExceptionStatus.RequestCanceled can be raised in other situations except cancellation, use flag to filter out false positives - -// // Use CreateTryWithFilterAsync to allow propagation of exception without losing stack -// Async.FromBeginEnd(beginAction=req.BeginGetResponse, -// endAction = req.EndGetResponse, -// cancelAction = fun() -> canceled <- true; req.Abort()) -// |> CreateTryWithFilterAsync (fun exn -> -// match exn with -// | :? System.Net.WebException as webExn -// when webExn.Status = System.Net.WebExceptionStatus.RequestCanceled && canceled -> - -// Some (Async.BindResult(AsyncResult.Canceled (OperationCanceledException webExn.Message))) -// | _ -> -// None) - -// type System.Net.WebClient with -// member inline private this.Download(event: IEvent<'T, _>, handler: _ -> 'T, start, result) = -// let downloadAsync = -// Async.FromContinuations (fun (cont, econt, ccont) -> -// let userToken = obj() -// let rec delegate' (_: obj) (args: #ComponentModel.AsyncCompletedEventArgs) = -// // ensure we handle the completed event from correct download call -// if userToken = args.UserState then -// event.RemoveHandler handle -// if args.Cancelled then -// ccont (OperationCanceledException()) -// elif isNotNull args.Error then -// econt args.Error -// else -// cont (result args) -// and handle = handler delegate' -// event.AddHandler handle -// start userToken -// ) - -// async2 { -// use! _holder = Async.OnCancel(fun _ -> this.CancelAsync()) -// return! downloadAsync -// } - -// [] // give the extension member a 'nice', unmangled compiled name, unique within this module -// member this.AsyncDownloadString (address:Uri) : Async2 = -// this.Download( -// event = this.DownloadStringCompleted, -// handler = (fun action -> Net.DownloadStringCompletedEventHandler action), -// start = (fun userToken -> this.DownloadStringAsync(address, userToken)), -// result = (fun args -> args.Result) -// ) - -// [] // give the extension member a 'nice', unmangled compiled name, unique within this module -// member this.AsyncDownloadData (address:Uri) : Async2 = -// this.Download( -// event = this.DownloadDataCompleted, -// handler = (fun action -> Net.DownloadDataCompletedEventHandler action), -// start = (fun userToken -> this.DownloadDataAsync(address, userToken)), -// result = (fun args -> args.Result) -// ) - -// [] // give the extension member a 'nice', unmangled compiled name, unique within this module -// member this.AsyncDownloadFile (address:Uri, fileName:string) : Async2 = -// this.Download( -// event = this.DownloadFileCompleted, -// handler = (fun action -> ComponentModel.AsyncCompletedEventHandler action), -// start = (fun userToken -> this.DownloadFileAsync(address, fileName, userToken)), -// result = (fun _ -> ()) -// ) - -module Examples = - - let t1 () = - async2 { - printfn "in t1" - do! Async2.Sleep 100 - printfn "resuming t1" - - return "a" - } - - let testTailcallTiny () = - async2 { - return! t1() - } - let rec testTailcall (n: int) = - async2 { - if n % 100 = 0 then - printfn $"in t1, n = {n}" - if n > 0 then - return! testTailcall(n-1) - //yield () - } - - //let t2 () = - // async2 { - // printfn "in t2" - // yield "d" - // printfn "in t2 b" - // for x in t1 () do - // printfn "t2 - got %A" x - // yield "e" - // let! v = - // task { - // printfn "hey yo" - // do! Task.Delay(200) - // } - // yield "[T1]" + x - // let! v = - // task { - // printfn "hey yo" - // do! Task.Delay(10) - // } - // yield "f" - // } - - let perf1 (x: int) = - async2 { - return 1 - } - - //let perf1_AsyncSeq (x: int) = - // FSharp.Control.AsyncSeqExtensions.asyncSeq { - // yield 1 - // yield 2 - // if x >= 2 then - // yield 3 - // yield 4 - // } - - //let perf2_AsyncSeq () = - // FSharp.Control.AsyncSeqExtensions.asyncSeq { - // for i1 in perf1_AsyncSeq 3 do - // for i2 in perf1_AsyncSeq 3 do - // for i3 in perf1_AsyncSeq 3 do - // for i4 in perf1_AsyncSeq 3 do - // for i5 in perf1_AsyncSeq 3 do - // yield! perf1_AsyncSeq i5 - // } - - let dumpAsync2 (t: Async2<_>) = - printfn "-----" - let e = t.StartImmediate(CancellationToken()) - let res = e.Task.Result - printfn "result: %A" res - - //dumpAsync2 (t1()) - dumpAsync2 (testTailcallTiny()) - ////dumpAsync2 (t2()) - - //printfn "t1() = %A" (Async2.toArray (t1())) - //printfn "testTailcallTiny() = %A" (Async2.toArray (testTailcallTiny())) - //dumpAsync2 (testTailcall(100000)) - //printfn "t2() = %A" (Async2.toArray (t2())) - - //printfn "perf2() = %A" (Async2.toArray (perf2()) |> Array.sum) - diff --git a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/async2.fsi b/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/async2.fsi deleted file mode 100644 index 9398b1223c2..00000000000 --- a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/async2.fsi +++ /dev/null @@ -1,255 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace rec FSharp.Control.Async2 - -open System -open System.Threading -open System.Threading.Tasks -open FSharp.Core.CompilerServices -open System.Runtime.CompilerServices - -[] -type Async2StateMachineData<'T> = - new: unit -> Async2StateMachineData<'T> - [] - val mutable cancellationToken: CancellationToken - [] - val mutable result: 'T - [] - val mutable builder: AsyncTaskMethodBuilder<'T> - [] - val mutable taken: bool - //// For tailcalls using 'return!' - //[] - //val mutable tailcallTarget: IAsync2Invocation<'T> - -type Async2Code<'TOverall, 'T> = ResumableCode, 'T> -and Async2StateMachine<'T> = ResumableStateMachine> -and Async2ResumptionFunc<'T> = ResumptionFunc> -and Async2ResumptionDynamicInfo<'T> = ResumptionDynamicInfo> - -type IAsync2Invokable<'T> = - abstract StartImmediate: CancellationToken -> IAsync2Invocation<'T> - -type IAsync2Invocation<'T> = - inherit IAsyncStateMachine - //abstract TailcallTarget: IAsync2Invocation<'T> - abstract CancellationToken: CancellationToken - abstract Task: Task<'T> - -[] -type Async2<'T> = - interface IAsync2Invokable<'T> - interface IAsync2Invocation<'T> - interface IAsyncStateMachine - member inline StartImmediate: ct: CancellationToken -> IAsync2Invocation<'T> - -[] -type Async2<'Machine, 'T when 'Machine :> IAsyncStateMachine and 'Machine :> IResumableStateMachine>> = - new : unit -> Async2<'Machine, 'T> - inherit Async2<'T> - [] - val mutable Machine: 'Machine - interface IAsyncStateMachine - interface IAsync2Invokable<'T> - interface IAsync2Invocation<'T> - -[] -type Async2 = - - static member RunSynchronously: computation:Async2<'T> * ?timeout: int * ?cancellationToken:CancellationToken-> 'T - - static member Start: computation:Async2 * ?cancellationToken:CancellationToken -> unit - - static member StartAsTask: computation:Async2<'T> * ?taskCreationOptions:TaskCreationOptions * ?cancellationToken:CancellationToken -> Task<'T> -(* - static member StartChildAsTask: computation:Async2<'T> * ?taskCreationOptions:TaskCreationOptions -> Async2> -*) - - static member Catch: computation:Async2<'T> -> Async2> - - (* - static member TryCancelled: computation:Async2<'T> * compensation:(OperationCanceledException -> unit) -> Async2<'T> - - static member OnCancel: interruption: (unit -> unit) -> Async2 - *) - - static member CancellationToken: Async2 - - static member CancelDefaultToken: unit -> unit - - static member DefaultCancellationToken: CancellationToken - - //---------- Parallelism -(* - static member StartChild: computation:Async2<'T> * ?millisecondsTimeout: int -> Async2> - - static member Parallel: computations:seq> -> Async2<'T[]> - - static member Parallel: computations:seq> * ?maxDegreeOfParallelism: int -> Async2<'T[]> - - static member Sequential: computations:seq> -> Async2<'T[]> - - static member Choice: computations:seq> -> Async2<'T option> -*) - static member SwitchToNewThread: unit -> Async2 - - static member SwitchToThreadPool: unit -> Async2 - -(* - static member SwitchToContext: syncContext:System.Threading.SynchronizationContext -> Async2 - - static member FromContinuations: callback:(('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) -> Async2<'T> - - static member AwaitEvent: event:IEvent<'Del,'T> * ?cancelAction: (unit -> unit) -> Async2<'T> when 'Del: delegate<'T,unit> and 'Del :> System.Delegate - - static member AwaitWaitHandle: waitHandle: WaitHandle * ?millisecondsTimeout:int -> Async2 - - static member AwaitIAsyncResult: iar: System.IAsyncResult * ?millisecondsTimeout:int -> Async2 -*) - static member AwaitTask: task: Task<'T> -> Async2<'T> - - static member AwaitTask: task: Task -> Async2 - - static member Sleep: millisecondsDueTime:int -> Async2 - - static member Ignore: computation: Async2<'T> -> Async2 -(* - static member StartWithContinuations: - computation:Async2<'T> * - continuation:('T -> unit) * exceptionContinuation:(exn -> unit) * cancellationContinuation:(OperationCanceledException -> unit) * - ?cancellationToken:CancellationToken-> unit -*) - static member StartImmediate: - computation:Async2 * ?cancellationToken:CancellationToken-> unit - - static member StartImmediateAsTask: - computation:Async2<'T> * ?cancellationToken:CancellationToken-> Task<'T> - -(* -type Async2Return - -[] -type Async2Activation<'T> = - - member IsCancellationRequested: bool - - member OnSuccess: 'T -> Async2Return - - member OnExceptionRaised: unit -> unit - - member OnCancellation: unit -> Async2Return - -[] -module Async2Primitives = - - val MakeAsync: body:(Async2Activation<'T> -> Async2Return) -> Async2<'T> - - val Invoke: computation: Async2<'T> -> ctxt:Async2Activation<'T> -> Async2Return - - val CallThenInvoke: ctxt:Async2Activation<'T> -> result1:'U -> part2:('U -> Async2<'T>) -> Async2Return - - val Bind: ctxt:Async2Activation<'T> -> part1:Async2<'U> -> part2:('U -> Async2<'T>) -> Async2Return - - val TryFinally: ctxt:Async2Activation<'T> -> computation: Async2<'T> -> finallyFunction: (unit -> unit) -> Async2Return - - val TryWith: ctxt:Async2Activation<'T> -> computation: Async2<'T> -> catchFunction: (Exception -> Async2<'T> option) -> Async2Return - -*) - -[] -type Async2Builder = - - member inline Run: code : Async2Code<'T, 'T> -> Async2<'T> - - [] - member inline Zero: unit -> Async2Code<'TOverall, unit> - - member inline Combine: task1: Async2Code<'TOverall, unit> * task2: Async2Code<'TOverall, 'T> -> Async2Code<'TOverall, 'T> - - member inline While: [] condition: (unit -> bool) * body: Async2Code<'TOverall, unit> -> Async2Code<'TOverall, unit> - - member inline Return: v: 'T -> Async2Code<'T, 'T> - - member inline ReturnFrom: task: Task<'T> -> Async2Code<'T, 'T> - - member inline ReturnFrom: computation: Async<'T> -> Async2Code<'T, 'T> - - member inline ReturnFrom: other: Async2<'T> -> Async2Code<'T, 'T> - - member inline Delay: f: (unit -> Async2Code<'TOverall, 'T>) -> Async2Code<'TOverall, 'T> - - member inline Using: resource: ('TResource :> IAsyncDisposable) * body: ('TResource -> Async2Code<'TOverall, 'T>) -> Async2Code<'TOverall, 'T> - - member inline TryFinally: body: Async2Code<'TOverall, 'T> * compensation: (unit -> unit) -> Async2Code<'TOverall, 'T> - - member inline TryWith: body: Async2Code<'TOverall, 'T> * catch: (exn -> Async2Code<'TOverall, 'T>) -> Async2Code<'TOverall, 'T> - - member inline Bind: task: Task<'TResult1> * continuation: ('TResult1 -> Async2Code<'TOverall, 'T>) -> Async2Code<'TOverall, 'T> - - member inline Bind: computation: Async<'TResult1> * continuation: ('TResult1 -> Async2Code<'TOverall, 'T>) -> Async2Code<'TOverall, 'T> - - member inline Bind: computation: Async2<'TResult1> * continuation: ('TResult1 -> Async2Code<'TOverall, 'T>) -> Async2Code<'TOverall, 'T> - - -[] -module Async2 = - type Async2Builder with - member inline ReturnFrom< ^TaskLike, ^Awaiter, ^T - when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) - and ^Awaiter :> ICriticalNotifyCompletion - and ^Awaiter: (member get_IsCompleted: unit -> bool) - and ^Awaiter: (member GetResult: unit -> ^T)> - : task: ^TaskLike -> Async2Code< ^T, ^T> - - member inline Bind< ^TaskLike, ^TResult1, 'TResult2, ^Awaiter , 'TOverall - when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) - and ^Awaiter :> ICriticalNotifyCompletion - and ^Awaiter: (member get_IsCompleted: unit -> bool) - and ^Awaiter: (member GetResult: unit -> ^TResult1)> - : task: ^TaskLike * continuation: (^TResult1 -> Async2Code<'TOverall, 'TResult2>) -> Async2Code<'TOverall, 'TResult2> - - member inline Using: resource: ('TResource :> IDisposable) * body: ('TResource -> Async2Code<'TOverall, 'T>) -> Async2Code<'TOverall, 'T> - - member inline For: sequence: seq<'TElement> * body: ('TElement -> Async2Code<'TOverall, unit>) -> Async2Code<'TOverall, unit> - - val async2: Async2Builder -//[] -///// A module of extension members providing asynchronous operations for some basic CLI types related to concurrency and I/O. -///// -///// Async Programming -//module CommonExtensions = - -// type System.IO.Stream with - -// /// Returns an asynchronous computation that will read from the stream into the given buffer. -// /// The buffer to read into. -// /// An optional offset as a number of bytes in the stream. -// /// An optional number of bytes to read from the stream. -// /// -// /// An asynchronous computation that will read from the stream into the given buffer. -// /// Thrown when the sum of offset and count is longer than -// /// the buffer length. -// /// Thrown when offset or count is negative. -// member AsyncRead: buffer:byte[] * ?offset:int * ?count:int -> Async2 - -// /// Returns an asynchronous computation that will read the given number of bytes from the stream. -// /// -// /// The number of bytes to read. -// /// -// /// An asynchronous computation that returns the read byte[] when run. -// member AsyncRead: count:int -> Async2 - -// /// Returns an asynchronous computation that will write the given bytes to the stream. -// /// -// /// The buffer to write from. -// /// An optional offset as a number of bytes in the stream. -// /// An optional number of bytes to write to the stream. -// /// -// /// An asynchronous computation that will write the given bytes to the stream. -// /// Thrown when the sum of offset and count is longer than -// /// the buffer length. -// /// Thrown when offset or count is negative. -// member AsyncWrite: buffer:byte[] * ?offset:int * ?count:int -> Async2 - - diff --git a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/coroutine.fs b/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/coroutine.fs deleted file mode 100644 index 04c4defdbfc..00000000000 --- a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/coroutine.fs +++ /dev/null @@ -1,279 +0,0 @@ - - -// This is a sample and test showing how to use resumable code to implement -// coroutines with tailcall support -// -// A coroutine is a value of type Coroutine normally constructed using this form: -// -// coroutine { -// printfn "in t1" -// yield () -// printfn "hey" -// } -// -// We also support `yield!` and tailcalls using the (non-standard) syntax of `return!`/ReturnFrom - -module Tests.Coroutines - -open System -open System.Runtime.CompilerServices -open FSharp.Core.CompilerServices -open FSharp.Core.CompilerServices.StateMachineHelpers -open FSharp.Core.LanguagePrimitives.IntrinsicOperators -open FSharp.Collections - -let verbose = false - -/// Helpers to do zero-allocation call to interface methods on structs -[] -module internal Helpers = - let inline MoveNext(x: byref<'T> when 'T :> IAsyncStateMachine) = x.MoveNext() - let inline SetStateMachine(x: byref<'T> when 'T :> IAsyncStateMachine, state) = x.SetStateMachine(state) - let inline GetResumptionPoint(x: byref<'T> when 'T :> IResumableStateMachine<'Data>) = x.ResumptionPoint - -/// This is the type of coroutines -[] -type Coroutine() = - - /// Checks if the coroutine is completed - abstract IsCompleted: bool - - /// Executes the coroutine until the next 'yield' - abstract MoveNext: unit -> unit - - /// Gets the tailcall target if the coroutine has executed a `return!` - abstract TailcallTarget: Coroutine option - -/// This is the implementation of Coroutine with respect to a particular struct state machine type. -and [] - Coroutine<'Machine when 'Machine : struct - and 'Machine :> IAsyncStateMachine - and 'Machine :> ICoroutineStateMachine>() = - inherit Coroutine() - - // The state machine struct - [] - val mutable Machine: 'Machine - - override cr.IsCompleted = - match cr.TailcallTarget with - | None -> - GetResumptionPoint(&cr.Machine) = -1 - | Some tg -> - tg.IsCompleted - - override cr.TailcallTarget = - CoroutineStateMachineData.GetHijackTarget(&cr.Machine) - - override cr.MoveNext() = - match cr.TailcallTarget with - | None -> //if verbose then printfn $"[{cr.Id}] move" - MoveNext(&cr.Machine) - | Some tg -> - match tg.TailcallTarget with - | None -> tg.MoveNext() - | Some tg2 -> - // Cut out chains of tailcalls - CoroutineStateMachineData.SetHijackTarget(&cr.Machine, tg2) - tg2.MoveNext() -/// This extra data stored in ResumableStateMachine (and it's templated copies using __stateMachine) -/// It only contains one field, the hijack target for tailcalls. -and [] - CoroutineStateMachineData = - - /// This is used for tailcalls using 'return!' - [] - val mutable TailcallTarget: Coroutine option - - static member GetHijackTarget(x: byref<'Machine> when 'Machine :> IResumableStateMachine) = - x.Data.TailcallTarget - - static member SetHijackTarget(x: byref<'Machine>, tg: Coroutine) : unit when 'Machine :> IResumableStateMachine = - let mutable newData = CoroutineStateMachineData() - newData.TailcallTarget <- Some tg - x.Data <- newData - -/// These are standard definitions filling in the 'Data' parameter of each -and ICoroutineStateMachine = IResumableStateMachine -and CoroutineStateMachine = ResumableStateMachine -and CoroutineResumptionFunc = ResumptionFunc -and CoroutineResumptionDynamicInfo = ResumptionDynamicInfo -and CoroutineCode = ResumableCode - - -/// The builder for tailcalls, defined using resumable code combinators -type CoroutineBuilder() = - - member inline _.Delay(f : unit -> CoroutineCode) : CoroutineCode = ResumableCode.Delay(f) - - /// Create the state machine and outer execution logic - member inline _.Run(code : CoroutineCode) : Coroutine = - if __useResumableCode then - __stateMachine - - // IAsyncStateMachine.MoveNext - (MoveNextMethodImpl<_>(fun sm -> - //-- RESUMABLE CODE START - __resumeAt sm.ResumptionPoint - let __stack_code_fin = code.Invoke(&sm) - if __stack_code_fin then - sm.ResumptionPoint <- -1 // indicates complete - else - // Goto request - match sm.Data.TailcallTarget with - | Some tg -> tg.MoveNext() // recurse - | None -> () - //-- RESUMABLE CODE END - )) - - // IAsyncStateMachine.SetStateMachine - (SetStateMachineMethodImpl<_>(fun sm state -> SetStateMachine(&sm, state))) - - // Box the coroutine. In this example we don't start execution of the coroutine. - (AfterCode<_,_>(fun sm -> - let mutable cr = Coroutine() - cr.Machine <- sm - cr :> Coroutine)) - else - // The dynamic implementation - let initialResumptionFunc = CoroutineResumptionFunc(fun sm -> code.Invoke(&sm)) - let resumptionInfo = - { new CoroutineResumptionDynamicInfo(initialResumptionFunc) with - member info.MoveNext(sm) = - if info.ResumptionFunc.Invoke(&sm) then - sm.ResumptionPoint <- -1 - member info.SetStateMachine(sm, state) = () - } - let mutable cr = Coroutine() - cr.Machine.ResumptionDynamicInfo <- resumptionInfo - cr :> Coroutine - - /// Used to represent no-ops like the implicit empty "else" branch of an "if" expression. - [] - member inline _.Zero() : CoroutineCode = ResumableCode.Zero() - - /// Chains together a step with its following step. - /// Note that this requires that the first step has no result. - /// This prevents constructs like `task { return 1; return 2; }`. - member inline _.Combine(code1: CoroutineCode, code2: CoroutineCode) : CoroutineCode = - ResumableCode.Combine(code1, code2) - - /// Builds a step that executes the body while the condition predicate is true. - member inline _.While ([] condition : unit -> bool, body : CoroutineCode) : CoroutineCode = - ResumableCode.While(condition, body) - - /// Wraps a step in a try/with. This catches exceptions both in the evaluation of the function - /// to retrieve the step, and in the continuation of the step (if any). - member inline _.TryWith (body: CoroutineCode, catch: exn -> CoroutineCode) : CoroutineCode = - ResumableCode.TryWith(body, catch) - - /// Wraps a step in a try/finally. This catches exceptions both in the evaluation of the function - /// to retrieve the step, and in the continuation of the step (if any). - member inline _.TryFinally (body: CoroutineCode, [] compensation : unit -> unit) : CoroutineCode = - ResumableCode.TryFinally(body, ResumableCode<_,_>(fun _ -> compensation(); true)) - - member inline _.Using (resource : 'Resource, body : 'Resource -> CoroutineCode) : CoroutineCode when 'Resource :> IDisposable = - ResumableCode.Using(resource, body) - - member inline _.For (sequence : seq<'T>, body : 'T -> CoroutineCode) : CoroutineCode = - ResumableCode.For(sequence, body) - - member inline _.Yield (_dummy: unit) : CoroutineCode = - ResumableCode.Yield() - - // The implementation of `yield!` - member inline _.YieldFrom (other: Coroutine) : CoroutineCode = - ResumableCode.While((fun () -> not other.IsCompleted), CoroutineCode(fun sm -> - other.MoveNext() - let __stack_other_fin = other.IsCompleted - if not __stack_other_fin then - // This will yield with __stack_yield_fin = false - // This will resume with __stack_yield_fin = true - let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) - __stack_yield_fin - else - true)) - - // The implementation of `return!`, non-standard for tailcalls - member inline _.ReturnFrom (other: Coroutine) : CoroutineCode = - ResumableCode<_,_>(fun sm -> - sm.Data.TailcallTarget <- Some other - // For tailcalls we return 'false' and re-run from the entry (trampoline) - false - // We could do this immediately with future cut-out, though this will stack-dive on sync code. - // We could also trampoline less frequently via a counter - // b.YieldFrom(other).Invoke(&sm) - ) - -[] -module CoroutineBuilder = - - let coroutine = CoroutineBuilder() - - -module Examples = - - let t1 () = - coroutine { - printfn "in t1" - yield () - printfn "hey ho" - yield () - yield! - coroutine{ - printfn "hey yo" - yield () - printfn "hey go" - } - } - - let testTailcallTiny () = - coroutine { - return! t1() - } - let rec testTailcall (n: int) = - coroutine { - if n % 100 = 0 then printfn $"in t1, n = {n}" - yield () - if n > 0 then - return! testTailcall(n-1) - } - - - let t2 () = - coroutine { - printfn "in t2" - yield () - printfn "in t2 b" - yield! t1() - //for x in t1 () do - // printfn "t2 - got %A" x - // yield () - // yield! - // coroutine { - // printfn "hey yo" - // } - // yield "[T1]" + x - yield! - coroutine { - printfn "hey yo" - //do! Task.Delay(10) - } - yield () - } - - - let dumpCoroutine (t: Coroutine) = - printfn "-----" - while ( //if verbose then printfn $"[{t.Id}] calling t.MoveNext, will resume at {t.ResumptionPoint}"; - t.MoveNext() - not t.IsCompleted) do - () // printfn "yield" - - dumpCoroutine (t1()) - dumpCoroutine (testTailcallTiny()) - dumpCoroutine (testTailcall(1000000)) - dumpCoroutine (t2()) - - - diff --git a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/coroutineBasic.fs b/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/coroutineBasic.fs deleted file mode 100644 index 8f8d707b6de..00000000000 --- a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/coroutineBasic.fs +++ /dev/null @@ -1,169 +0,0 @@ -// This is a sample and test showing how to use resumable code to implement coroutines -// -// A coroutine is a value of type Coroutine normally constructed using this form: -// -// coroutine { -// printfn "in t1" -// yield () -// printfn "hey" -// } - -module rec Tests.CoroutinesBasic - -open System -open System.Runtime.CompilerServices -open FSharp.Core.CompilerServices -open FSharp.Core.CompilerServices.StateMachineHelpers - -/// This is the type of coroutines -[] -type Coroutine() = - - /// Checks if the coroutine is completed - abstract IsCompleted: bool - - /// Executes the coroutine until the next 'yield' - abstract MoveNext: unit -> unit - -/// Helpers to do zero-allocation call to interface methods on structs -[] -module internal Helpers = - let inline MoveNext(x: byref<'T> when 'T :> IAsyncStateMachine) = x.MoveNext() - let inline GetResumptionPoint(x: byref<'T> when 'T :> IResumableStateMachine<'Data>) = x.ResumptionPoint - let inline SetData(x: byref<'T> when 'T :> IResumableStateMachine<'Data>, data) = x.Data <- data - -/// This is the implementation of Coroutine with respect to a particular struct state machine type. -[] -type Coroutine<'Machine when 'Machine : struct - and 'Machine :> IAsyncStateMachine - and 'Machine :> ICoroutineStateMachine>() = - inherit Coroutine() - - // The state machine struct - [] - val mutable Machine: 'Machine - - override cr.IsCompleted = - GetResumptionPoint(&cr.Machine) = -1 - - override cr.MoveNext() = - MoveNext(&cr.Machine) - -/// This extra data stored in ResumableStateMachine (and it's templated copies using __stateMachine) -/// In this example there is just an ID -[] -type CoroutineStateMachineData(id: int) = - member _.Id = id - -let nextId = - let mutable n = 0 - fun () -> n <- n + 1; n - -/// These are standard definitions filling in the 'Data' parameter of each -type ICoroutineStateMachine = IResumableStateMachine -type CoroutineStateMachine = ResumableStateMachine -type CoroutineResumptionFunc = ResumptionFunc -type CoroutineResumptionDynamicInfo = ResumptionDynamicInfo -type CoroutineCode = ResumableCode - -type CoroutineBuilder() = - - member inline _.Delay(f : unit -> CoroutineCode) : CoroutineCode = ResumableCode.Delay(f) - - /// Used to represent no-ops like the implicit empty "else" branch of an "if" expression. - [] - member inline _.Zero() : CoroutineCode = ResumableCode.Zero() - - // The implementation of `e1; e2` - member inline _.Combine(code1: CoroutineCode, code2: CoroutineCode) : CoroutineCode = - ResumableCode.Combine(code1, code2) - - // The implementation of `while` - member inline _.While ([] condition : unit -> bool, body : CoroutineCode) : CoroutineCode = - ResumableCode.While(condition, body) - - // The implementation of `try/with` - member inline _.TryWith (body: CoroutineCode, catch: exn -> CoroutineCode) : CoroutineCode = - ResumableCode.TryWith(body, catch) - - // The implementation of `try/finally` - member inline _.TryFinally (body: CoroutineCode, [] compensation : unit -> unit) : CoroutineCode = - ResumableCode.TryFinally(body, ResumableCode<_,_>(fun _ -> compensation(); true)) - - // The implementation of `use` - member inline _.Using (resource : 'Resource, body : 'Resource -> CoroutineCode) : CoroutineCode when 'Resource :> IDisposable = - ResumableCode.Using(resource, body) - - // The implementation of `for` - member inline _.For (sequence : seq<'T>, body : 'T -> CoroutineCode) : CoroutineCode = - ResumableCode.For(sequence, body) - - // The implementation of `yield` - member inline _.Yield (_dummy: unit) : CoroutineCode = - ResumableCode.Yield() - - // The implementation of `yield!` - member inline _.YieldFrom (other: Coroutine) : CoroutineCode = - ResumableCode.While((fun () -> not other.IsCompleted), CoroutineCode(fun sm -> - other.MoveNext() - let __stack_other_fin = other.IsCompleted - if not __stack_other_fin then - ResumableCode.Yield().Invoke(&sm) - else - true)) - - /// Create the state machine and outer execution logic - member inline _.Run(code : CoroutineCode) : Coroutine = - if __useResumableCode then - __stateMachine - - // IAsyncStateMachine.MoveNext - (MoveNextMethodImpl<_>(fun sm -> - __resumeAt sm.ResumptionPoint - let __stack_code_fin = code.Invoke(&sm) - if __stack_code_fin then - sm.ResumptionPoint <- -1 // indicates complete - )) - - // IAsyncStateMachine.SetStateMachine - (SetStateMachineMethodImpl<_>(fun sm state -> ())) - - // Box the coroutine. In this example we don't start execution of the coroutine. - (AfterCode<_,_>(fun sm -> - let mutable cr = Coroutine() - SetData(&cr.Machine, CoroutineStateMachineData(nextId())) - cr.Machine <- sm - cr :> Coroutine)) - else - // The dynamic implementation - let initialResumptionFunc = CoroutineResumptionFunc(fun sm -> code.Invoke(&sm)) - let resumptionInfo = - { new CoroutineResumptionDynamicInfo(initialResumptionFunc) with - member info.MoveNext(sm) = - if info.ResumptionFunc.Invoke(&sm) then - sm.ResumptionPoint <- -1 - member info.SetStateMachine(sm, state) = () - } - let mutable cr = Coroutine() - cr.Machine.ResumptionDynamicInfo <- resumptionInfo - cr :> Coroutine - -[] -module CoroutineBuilder = - - let coroutine = CoroutineBuilder() - -module Examples = - let t1 () = - coroutine { - printfn "in t1" - yield () - printfn "hey ho" - yield () - } - let dumpCoroutine (t: Coroutine) = - printfn "-----" - while ( t.MoveNext() - not t.IsCompleted) do - printfn "yield" - diff --git a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/empty.fs b/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/empty.fs deleted file mode 100644 index 41ce540367b..00000000000 --- a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/empty.fs +++ /dev/null @@ -1,5 +0,0 @@ - -module Tests.Empty - - -let _ = printfn "hello" \ No newline at end of file diff --git a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/list.fs b/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/list.fs deleted file mode 100644 index 14240aac764..00000000000 --- a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/list.fs +++ /dev/null @@ -1,195 +0,0 @@ - -module Tests.ListBuilders - -#if FSHARP_CORE_HAS_LIST_COLLECTOR -open System -open System.Collections.Generic -open FSharp.Core.CompilerServices - -#nowarn "57" - -[] -module UsingInlinedCodeAndCollector = - [] - type ListBuilderCollector<'T> = - [] - val mutable Collector : ListCollector<'T> - - member sm.Yield (value: 'T) = sm.Collector.Yield(value) - - member sm.ToList() = sm.Collector.ToList() - - type ListBuilderCode<'T> = delegate of byref> -> unit - - type ListBuilderViaCollector() = - - member inline _.Delay([] f: unit -> ListBuilderCode<'T>) : ListBuilderCode<'T> = - ListBuilderCode<_>(fun sm -> (f()).Invoke &sm) - - member inline _.Zero() : ListBuilderCode<'T> = - ListBuilderCode<_>(fun _sm -> ()) - - member inline _.Combine([] part1: ListBuilderCode<'T>, [] part2: ListBuilderCode<'T>) : ListBuilderCode<'T> = - ListBuilderCode<_>(fun sm -> - part1.Invoke &sm - part2.Invoke &sm) - - member inline _.While([] condition : unit -> bool, [] body : ListBuilderCode<'T>) : ListBuilderCode<'T> = - ListBuilderCode<_>(fun sm -> - while condition() do - body.Invoke &sm) - - member inline _.TryWith([] body: ListBuilderCode<'T>, [] handler: exn -> ListBuilderCode<'T>) : ListBuilderCode<'T> = - ListBuilderCode<_>(fun sm -> - try - body.Invoke &sm - with exn -> - (handler exn).Invoke &sm) - - member inline _.TryFinally([] body: ListBuilderCode<'T>, compensation : unit -> unit) : ListBuilderCode<'T> = - ListBuilderCode<_>(fun sm -> - try - body.Invoke &sm - with _ -> - compensation() - reraise() - - compensation()) - - member inline b.Using(disp : #IDisposable, [] body: #IDisposable -> ListBuilderCode<'T>) : ListBuilderCode<'T> = - // A using statement is just a try/finally with the finally block disposing if non-null. - b.TryFinally( - (fun sm -> (body disp).Invoke &sm), - (fun () -> if not (isNull (box disp)) then disp.Dispose())) - - member inline b.For(sequence: seq<'TElement>, [] body: 'TElement -> ListBuilderCode<'T>) : ListBuilderCode<'T> = - b.Using (sequence.GetEnumerator(), - (fun e -> b.While((fun () -> e.MoveNext()), (fun sm -> (body e.Current).Invoke &sm)))) - - member inline _.Yield (v: 'T) : ListBuilderCode<'T> = - ListBuilderCode<_>(fun sm -> - sm.Yield v) - - member inline b.YieldFrom (source: IEnumerable<'T>) : ListBuilderCode<'T> = - b.For(source, (fun value -> b.Yield(value))) - - member inline _.Run([] code: ListBuilderCode<'T>) : 'T list = - let mutable sm = ListBuilderCollector<'T>() - code.Invoke &sm - sm.ToList() - - let listc = ListBuilderViaCollector() - -module Examples = - let t1C () = - listc { - printfn "in t1" - yield "a" - let x = "d" - yield "b" - yield "c" + x - } - - let t2C () = - listc { - printfn "in t2" - yield "d" - for x in t1C () do - printfn "t2 - got %A" x - yield "e" - yield "[T1]" + x - yield "f" - } - - let tinyVariableSizeNew () = - for i in 1 .. 1000000 do - listc { - if i % 3 = 0 then - yield "b" - } |> List.length |> ignore - - let tinyVariableSizeBuiltin () = - for i in 1 .. 1000000 do - [ - if i % 3 = 0 then - yield "b" - ] |> List.length |> ignore - - let variableSizeNew () = - for i in 1 .. 1000000 do - listc { - yield "a" - yield "b" - yield "b" - yield "b" - yield "b" - if i % 3 = 0 then - yield "b" - yield "b" - yield "b" - yield "b" - yield "c" - } |> List.length |> ignore - - let variableSizeBuiltin () = - for i in 1 .. 1000000 do - [ - yield "a" - yield "b" - yield "b" - yield "b" - yield "b" - if i % 3 = 0 then - yield "b" - yield "b" - yield "b" - yield "b" - yield "c" - ] |> List.length |> ignore - - let fixedSizeC () = - for i in 1 .. 1000000 do - listc { - "a" - "b" - "b" - "b" - "b" - "b" - "b" - "b" - "b" - "c" - } |> List.length |> ignore - - let fixedSizeBase () = - for i in 1 .. 1000000 do - [ - "a" - "b" - "b" - "b" - "b" - "b" - "b" - "b" - "b" - "c" - ] |> List.length |> ignore - - let perf s f = - let t = System.Diagnostics.Stopwatch() - t.Start() - f() - t.Stop() - printfn "PERF: %s : %d" s t.ElapsedMilliseconds - - perf "tinyVariableSizeBuiltin" tinyVariableSizeBuiltin - perf "tinyVariableSizeNew " tinyVariableSizeNew - - perf "variableSizeBuiltin" variableSizeBuiltin - perf "variableSizeNew" variableSizeNew - - perf "fixedSizeBase" fixedSizeBase - perf "fixedSizeC" fixedSizeC -#endif \ No newline at end of file diff --git a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/option.fs b/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/option.fs deleted file mode 100644 index 2df8610880f..00000000000 --- a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/option.fs +++ /dev/null @@ -1,310 +0,0 @@ - -module Tests.OptionBuilders - -open System - -type OptionCode<'T> = unit -> 'T voption - -type OptionBuilderUsingInlineIfLambdaBase() = - - member inline _.Delay([] f : unit -> OptionCode<'T>) : OptionCode<'T> = - (fun () -> (f())()) - // Note, not "f()()" - the F# compiler optimzier likes arguments to match lamdas in order to preserve - // argument evaluation order, so for "(f())()" the optimizer reduces one lambda then another, while "f()()" doesn't - - member inline _.Combine([] task1: OptionCode, [] task2: OptionCode<'T>) : OptionCode<'T> = - (fun () -> - match task1() with - | ValueNone -> ValueNone - | ValueSome() -> task2()) - - member inline _.Bind(res1: 'T1 option, [] task2: ('T1 -> OptionCode<'T>)) : OptionCode<'T> = - (fun () -> - match res1 with - | None -> ValueNone - | Some v -> (task2 v)()) - - member inline _.Bind(res1: 'T1 voption, [] task2: ('T1 -> OptionCode<'T>)) : OptionCode<'T> = - (fun () -> - match res1 with - | ValueNone -> ValueNone - | ValueSome v -> (task2 v)()) - - member inline _.While([] condition : unit -> bool, [] body : OptionCode) : OptionCode = - (fun () -> - let mutable proceed = true - while proceed && condition() do - match body() with - | ValueNone -> proceed <- false - | ValueSome () -> () - ValueSome(())) - - member inline _.TryWith([] body : OptionCode<'T>, [] catch : exn -> OptionCode<'T>) : OptionCode<'T> = - (fun () -> - try - body() - with exn -> - (catch exn)()) - - member inline _.TryFinally([] body: OptionCode<'T>, [] compensation : unit -> unit) : OptionCode<'T> = - (fun () -> - let res = - try - body() - with _ -> - compensation() - reraise() - - compensation() - res) - - member inline this.Using(disp: #IDisposable, [] body: #IDisposable -> OptionCode<'T>) : OptionCode<'T> = - // A using statement is just a try/finally with the finally block disposing if non-null. - this.TryFinally( - (fun () -> (body disp)()), - (fun () -> if not (isNull (box disp)) then disp.Dispose())) - - member inline this.For(sequence : seq<'TElement>, [] body : 'TElement -> OptionCode) : OptionCode = - this.Using (sequence.GetEnumerator(), - (fun e -> this.While((fun () -> e.MoveNext()), (fun () -> (body e.Current)())))) - - member inline _.Return (value: 'T) : OptionCode<'T> = - (fun () -> - ValueSome value) - - member inline _.ReturnFrom (source: 'T option) : OptionCode<'T> = - (fun () -> - match source with Some x -> ValueOption.Some x | None -> ValueOption.None) - - member inline _.ReturnFrom (source: voption<'T>) : OptionCode<'T> = - (fun () -> source) - -type OptionBuilderUsingInlineIfLambda() = - inherit OptionBuilderUsingInlineIfLambdaBase() - - member inline _.Run([] code : OptionCode<'T>) : 'T option = - match code () with - | ValueNone -> None - | ValueSome v -> Some v - -type ValueOptionBuilderUsingInlineIfLambda() = - inherit OptionBuilderUsingInlineIfLambdaBase() - - member inline _.Run([] code : OptionCode<'T>) : 'T voption = - code() - -let optionNew = OptionBuilderUsingInlineIfLambda() -let voptionNew = ValueOptionBuilderUsingInlineIfLambda() - - -type SlowOptionBuilder() = - member inline _.Zero() = None - - member inline _.Return(x: 'T) = Some x - - member inline _.ReturnFrom(m: 'T option) = m - - member inline _.Bind(m: 'T option, f) = Option.bind f m - - member inline _.Delay(f: unit -> _) = f - - member inline _.Run(f) = f() - - member this.TryWith(delayedExpr, handler) = - try this.Run(delayedExpr) - with exn -> handler exn - - member this.TryFinally(delayedExpr, compensation) = - try this.Run(delayedExpr) - finally compensation() - - member this.Using(resource:#IDisposable, body) = - this.TryFinally(this.Delay(fun ()->body resource), fun () -> match box resource with null -> () | _ -> resource.Dispose()) - -let optionOld = SlowOptionBuilder() - -type SlowValueOptionBuilder() = - member inline _.Zero() = ValueNone - - member inline _.Return(x: 'T) = ValueSome x - - member inline _.ReturnFrom(m: 'T voption) = m - - member inline _.Bind(m: 'T voption, f) = ValueOption.bind f m - - member inline _.Delay(f: unit -> _) = f - - member inline _.Run(f) = f() - - member inline this.TryWith(delayedExpr, handler) = - try this.Run(delayedExpr) - with exn -> handler exn - - member inline this.TryFinally(delayedExpr, compensation) = - try this.Run(delayedExpr) - finally compensation() - - member inline this.Using(resource:#IDisposable, body) = - this.TryFinally(this.Delay(fun ()->body resource), fun () -> match box resource with null -> () | _ -> resource.Dispose()) - -let voptionOld = SlowValueOptionBuilder() - -module Examples = - - - let multiStepOldBuilder () = - let mutable res = 0 - for i in 1 .. 1000000 do - let v = - optionOld { - try - let! x1 = (if i % 5 <> 2 then Some i else None) - let! x2 = (if i % 3 <> 1 then Some i else None) - let! x3 = (if i % 3 <> 1 then Some i else None) - let! x4 = (if i % 3 <> 1 then Some i else None) - res <- res + 1 - return x1 + x2 + x3 + x4 - with e -> - return failwith "unexpected" - } - v |> ignore - res - - let multiStepOldBuilderV () = - let mutable res = 0 - for i in 1 .. 1000000 do - let v = - voptionOld { - try - let! x1 = (if i % 5 <> 2 then ValueSome i else ValueNone) - let! x2 = (if i % 3 <> 1 then ValueSome i else ValueNone) - let! x3 = (if i % 3 <> 1 then ValueSome i else ValueNone) - let! x4 = (if i % 3 <> 1 then ValueSome i else ValueNone) - res <- res + 1 - return x1 + x2 + x3 + x4 - with e -> - return failwith "unexpected" - } - v |> ignore - res - - let multiStepNoBuilder () = - let mutable res = 0 - for i in 1 .. 1000000 do - let v = - try - match (if i % 5 <> 2 then Some i else None) with - | None -> None - | Some x1 -> - match (if i % 3 <> 1 then Some i else None) with - | None -> None - | Some x2 -> - match (if i % 3 <> 1 then Some i else None) with - | None -> None - | Some x3 -> - match (if i % 3 <> 1 then Some i else None) with - | None -> None - | Some x4 -> - res <- res + 1 - Some (x1 + x2 + x3 + x4) - with e -> - failwith "unexpected" - v |> ignore - res - - let multiStepNoBuilderV () = - let mutable res = 0 - for i in 1 .. 1000000 do - let v = - try - match (if i % 5 <> 2 then ValueSome i else ValueNone) with - | ValueNone -> ValueNone - | ValueSome x1 -> - match (if i % 3 <> 1 then ValueSome i else ValueNone) with - | ValueNone -> ValueNone - | ValueSome x2 -> - match (if i % 3 <> 1 then ValueSome i else ValueNone) with - | ValueNone -> ValueNone - | ValueSome x3 -> - match (if i % 3 <> 1 then ValueSome i else ValueNone) with - | ValueNone -> ValueNone - | ValueSome x4 -> - res <- res + 1 - ValueSome (x1 + x2 + x3 + x4) - with e -> - failwith "unexpected" - v |> ignore - res - - let multiStepNewBuilder () = - let mutable res = 0 - for i in 1 .. 1000000 do - let v = - optionNew { - try - let! x1 = (if i % 5 <> 2 then Some i else None) - let! x2 = (if i % 3 <> 1 then Some i else None) - let! x3 = (if i % 3 <> 1 then Some i else None) - let! x4 = (if i % 3 <> 1 then Some i else None) - res <- res + 1 - return x1 + x2 + x3 + x4 - with e -> - return failwith "unexpected" - } - v |> ignore - res - - - let multiStepNewBuilderV () = - let mutable res = 0 - for i in 1 .. 1000000 do - let v = - voptionNew { - try - let! x1 = (if i % 5 <> 2 then ValueSome i else ValueNone) - let! x2 = (if i % 3 <> 1 then ValueSome i else ValueNone) - let! x3 = (if i % 3 <> 1 then ValueSome i else ValueNone) - let! x4 = (if i % 3 <> 1 then ValueSome i else ValueNone) - res <- res + 1 - return x1 + x2 + x3 + x4 - with e -> - return failwith "unexpected" - } - v |> ignore - res - - // let perf s f = - // let t = System.Diagnostics.Stopwatch() - // t.Start() - // for i in 1 .. 100 do - // f() |> ignore - // t.Stop() - // printfn "PERF: %s : %d" s t.ElapsedMilliseconds - - // printfn "check %d = %d = %d"(multiStepStateMachineBuilder()) (multiStepNoBuilder()) (multiStepOldBuilder()) - - // perf "perf (state mechine option)" multiStepStateMachineBuilder - // perf "perf (no builder option)" multiStepNoBuilder - // perf "perf (slow builder option)" multiStepOldBuilder - - // printfn "check %d = %d = %d" (multiStepStateMachineBuilderV()) (multiStepNoBuilder()) (multiStepOldBuilder()) - // perf "perf (state mechine voption)" multiStepStateMachineBuilderV - // perf "perf (no builder voption)" multiStepNoBuilderV - // perf "perf (slow builder voption)" multiStepOldBuilderV - -module A = - - let multiStepNewBuilder (i) = - let mutable res = 0 - optionNew { - try - let! x1 = (if i % 5 <> 2 then Some i else None) - let! x2 = (if i % 3 <> 1 then Some i else None) - let! x3 = (if i % 3 <> 1 then Some i else None) - let! x4 = (if i % 3 <> 1 then Some i else None) - res <- res + 1 - return x1 + x2 + x3 + x4 - with e -> - return failwith "unexpected" - } - diff --git a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/option2.fs b/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/option2.fs deleted file mode 100644 index 7d911b68890..00000000000 --- a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/option2.fs +++ /dev/null @@ -1,25 +0,0 @@ - -module Tests.OptionBuilderUsingInlineIfLambda - -open System - - - // let perf s f = - // let t = System.Diagnostics.Stopwatch() - // t.Start() - // for i in 1 .. 100 do - // f() |> ignore - // t.Stop() - // printfn "PERF: %s : %d" s t.ElapsedMilliseconds - - // printfn "check %d = %d = %d"(multiStepInlineIfLambdaBuilder()) (multiStepNoBuilder()) (multiStepOldBuilder()) - - // perf "perf (state mechine option)" multiStepInlineIfLambdaBuilder - // perf "perf (no builder option)" multiStepNoBuilder - // perf "perf (slow builder option)" multiStepOldBuilder - - // printfn "check %d = %d = %d" (multiStepInlineIfLambdaBuilderV()) (multiStepNoBuilder()) (multiStepOldBuilder()) - // perf "perf (state mechine voption)" multiStepInlineIfLambdaBuilderV - // perf "perf (no builder voption)" multiStepNoBuilderV - // perf "perf (slow builder voption)" multiStepOldBuilderV - diff --git a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/seq2.fs b/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/seq2.fs deleted file mode 100644 index 5df130c6eae..00000000000 --- a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/seq2.fs +++ /dev/null @@ -1,262 +0,0 @@ - -module Tests.Seq2 - -#nowarn "42" -open System -open System.Collections -open System.Collections.Generic -open System.Runtime.CompilerServices -open FSharp.Core.CompilerServices -open FSharp.Core.CompilerServices.StateMachineHelpers - -[] -type SeqStateMachine<'T>() = - let disposalStack = ResizeArray<(unit -> unit)>() - - /// Proceed to the next state or raise an exception. Returns true if completed - abstract Step : unit -> bool - - member val Current : 'T voption = ValueNone with get, set - - member val ResumptionPoint: int = 0 with get, set - - member val ResumptionFunc: (SeqStateMachine<'T> -> bool) = Unchecked.defaultof<_> with get, set - - interface IEnumerable with - member this.GetEnumerator() = - // TODO: make new object if needed - (this :> IEnumerator) - - interface IEnumerable<'T> with - member this.GetEnumerator() = - // TODO: make new object if needed - (this :> IEnumerator<'T>) - - interface IDisposable with - member __.Dispose() = - let mutable exn = None - for d in Seq.rev disposalStack do - try - d() - with e -> - exn <- Some e // keep the last exception - TODO - check this - match exn with - | None -> () - | Some e -> raise e - - interface IEnumerator with - - member __.Reset() = failwith "no reset supported" - member sm.Current = box sm.Current - member sm.MoveNext() = sm.Step() - - interface IEnumerator<'T> with - member sm.Current = match sm.Current with ValueNone -> failwith "no value available yet" | ValueSome x -> x - - member __.PushDispose (f: unit -> unit) = disposalStack.Add(f) - - member __.PopDispose () = disposalStack.RemoveAt(disposalStack.Count - 1) - - [] - member sm.Start() = (sm :> IEnumerable<'T>) - -type SeqCode<'T> = SeqStateMachine<'T> -> bool - -type SeqBuilder() = - - [] - member inline __.Delay(__expand_f : unit -> SeqCode<'T>) : SeqCode<'T> = (fun sm -> __expand_f () sm) - - [] - member inline __.Run(__expand_code : SeqCode<'T>) : IEnumerable<'T> = - if __useResumableCode then - (__resumableStateMachine - { new SeqStateMachine<'T>() with - member sm.Step () = - __resumeAt sm.ResumptionPoint - __expand_code sm }).Start() - else - let sm = - { new SeqStateMachine<'T>() with - member sm.Step () = - sm.ResumptionFunc sm } - sm.ResumptionFunc <- __expand_code - sm.Start() - - [] - member inline __.Zero() : SeqCode<'T> = - (fun _sm -> true) - - [] - member inline __.Combine(__expand_task1: SeqCode<'T>, __expand_task2: SeqCode<'T>) : SeqCode<'T> = - (fun sm -> - if __useResumableCode then - let __stack_step = __expand_task1 sm - if __stack_step then - __expand_task2 sm - else - false - else - let completed = __expand_task1 sm - if completed then - __expand_task2 sm - else - // If state machines are not supported, then we must adjust the resumption to also run __expand_task2 on completion - let rec resume rf = - (fun (sm: SeqStateMachine<_>) -> - let completed = rf sm - if completed then - __expand_task2 sm - else - sm.ResumptionFunc <- resume sm.ResumptionFunc - false) - - sm.ResumptionFunc <- resume sm.ResumptionFunc - false) - - [] - member inline __.While(__expand_condition : unit -> bool, __expand_body : SeqCode<'T>) : SeqCode<'T> = - (fun sm -> - if __useResumableCode then - let mutable __stack_completed = false - while __stack_completed && __expand_condition() do - // NOTE: The body of the 'while' may contain await points, resuming may branch directly into the while loop - let __stack_step = __expand_body sm - // If we make it to the assignment we prove we've made a step - __stack_completed <- __stack_step - __stack_completed - else - let rec repeat sm = - if __expand_condition() then - let step = __expand_body sm - if step then - repeat sm - else - //Console.WriteLine("[{0}] rebinding ResumptionFunc for While", sm.MethodBuilder.Task.Id) - sm.ResumptionFunc <- resume sm.ResumptionFunc - false - else - true - and resume mf sm = - //Console.WriteLine("[{0}] resume WhileLoop body", sm.MethodBuilder.Task.Id) - let step = mf sm - if step then - repeat sm - else - //Console.WriteLine("[{0}] rebinding ResumptionFunc for While", sm.MethodBuilder.Task.Id) - sm.ResumptionFunc <- resume sm.ResumptionFunc - false - - repeat sm) - - [] - member inline __.TryWith(__expand_body : SeqCode<'T>, __expand_catch : exn -> SeqCode<'T>) : SeqCode<'T> = - (fun sm -> - if __useResumableCode then - let mutable __stack_completed = false - let mutable __stack_caught = false - let mutable __stack_savedExn = Unchecked.defaultof<_> - try - // The try block may contain await points. - let __stack_step = __expand_body sm - // If we make it to the assignment we prove we've made a step - __stack_completed <- __stack_step - with exn -> - __stack_caught <- true - __stack_savedExn <- exn - - if __stack_caught then - // Place the catch code outside the catch block - __expand_catch __stack_savedExn sm - else - __stack_completed - else - failwith "tbd") - - [] - member inline __.TryFinally(__expand_body: SeqCode<'T>, compensation : unit -> unit) : SeqCode<'T> = - (fun sm -> - let mutable completed = false - sm.PushDispose compensation - try - let __stack_step = __expand_body sm - // If we make it to the assignment we prove we've made a step without an exception - completed <- __stack_step - with _ -> - sm.PopDispose() - compensation() - reraise() - - if completed then - sm.PopDispose() - compensation() - completed) - - [] - member inline this.Using(disp : #IDisposable, __expand_body : #IDisposable -> SeqCode<'T>) = - // A using statement is just a try/finally with the finally block disposing if non-null. - this.TryFinally( - (fun sm -> __expand_body disp sm), - (fun () -> if not (isNull (box disp)) then disp.Dispose())) - - [] - member inline this.For(sequence : seq<'TElement>, __expand_body : 'TElement -> SeqCode<'T>) : SeqCode<'T> = - // A for loop is just a using statement on the sequence's enumerator... - this.Using (sequence.GetEnumerator(), - // ... and its body is a while loop that advances the enumerator and runs the body on each element. - (fun e -> this.While((fun () -> e.MoveNext()), (fun sm -> __expand_body e.Current sm)))) - - [] - member inline __.Yield (v: 'T) : SeqCode<'T> = - (fun sm -> - if __useResumableCode then - match __resumableEntry() with - | Some contID -> - sm.ResumptionPoint <- contID - sm.Current <- ValueSome v - false - | None -> - sm.Current <- ValueNone - true - else - let cont (sm: SeqStateMachine<'T>) = - sm.Current <- ValueNone - true - sm.ResumptionFunc <- cont - sm.Current <- ValueSome v - false) - - [] - member inline this.YieldFrom (source: IEnumerable<'T>) : SeqCode<'T> = - this.For(source, (fun v -> this.Yield v)) - -let seq2 = SeqBuilder() - -module Examples = - - let t1 () = - seq2 { - printfn "in t1" - yield "a" - let x = 1 - yield "b" - yield "c" - } - - let t2 () = - seq2 { - printfn "in t2" - yield "d" - for x in t1 () do - printfn "t2 - got %A" x - yield "e" - yield "[T1]" + x - yield "f" - } - - let dumpSeq (t: IEnumerable<_>) = - let e = t.GetEnumerator() - while e.MoveNext() do - printfn "yield %A" e.Current - dumpSeq (t1()) - dumpSeq (t2()) diff --git a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/sync.fs b/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/sync.fs deleted file mode 100644 index 9a4ccb5b72f..00000000000 --- a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/sync.fs +++ /dev/null @@ -1,88 +0,0 @@ - -module Tests.SyncBuilder - -open System - -type SyncCode<'T> = unit -> 'T - -type SyncBuilder() = - - member inline _.Delay([] f: unit -> SyncCode<'T>) : SyncCode<'T> = - (fun () -> (f())()) - - member inline _.Run([] code : SyncCode<'T>) : 'T = - code() - -#if PREVIEW - [] -#endif - member inline _.Zero() : SyncCode< unit> = - (fun () -> ()) - - member inline _.Return (x: 'T) : SyncCode<'T> = - (fun () -> x) - - member inline _.Combine([] code1: SyncCode, [] code2: SyncCode<'T>) : SyncCode<'T> = - (fun () -> - code1() - code2()) - - member inline _.While([] condition: unit -> bool, [] body: SyncCode) : SyncCode = - (fun () -> - while condition() do - body()) - - member inline _.TryWith([] body: SyncCode<'T>, [] catch: exn -> 'T) : SyncCode<'T> = - (fun () -> - try - body() - with exn -> - catch exn) - - member inline _.TryFinally([] body: SyncCode<'T>, compensation: unit -> unit) : SyncCode<'T> = - (fun () -> - let __stack_step = - try - body() - with _ -> - compensation() - reraise() - compensation() - __stack_step) - - member inline this.Using(disp : #IDisposable, [] body: #IDisposable -> SyncCode<'T>) : SyncCode<'T> = - this.TryFinally( - (fun () -> (body disp)()), - (fun () -> if not (isNull (box disp)) then disp.Dispose())) - - member inline this.For(sequence : seq<'T>, [] body : 'T -> SyncCode) : SyncCode = - this.Using (sequence.GetEnumerator(), - (fun e -> this.While((fun () -> e.MoveNext()), (fun () -> (body e.Current)())))) - - member inline _.ReturnFrom (value: 'T) : SyncCode<'T> = - (fun () -> - value) - - member inline _.Bind (v: 'TResult1, [] continuation: 'TResult1 -> SyncCode<'TResult2>) : SyncCode<'TResult2> = - (fun () -> - (continuation v)()) - -let sync = SyncBuilder() - -module Examples = - - let t1 y = - sync { - let x = 4 + 5 + y - return x - } - - let t2 y = - sync { - printfn "in t2" - let! x = t1 y - return x + y - } - - - //printfn "t2 6 = %d" (t2 6) diff --git a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/taskSeq.fs b/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/taskSeq.fs deleted file mode 100644 index c87c79f37db..00000000000 --- a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerf/taskSeq.fs +++ /dev/null @@ -1,599 +0,0 @@ - -module Tests.TaskSeq - -open System.Runtime.CompilerServices -open System.Threading.Tasks.Sources - -#nowarn "42" -open System -open System.Collections.Generic -open System.Threading -open System.Threading.Tasks -open FSharp.Core.CompilerServices -open FSharp.Core.CompilerServices.StateMachineHelpers - -let verbose = false - -let inline MoveNext(x: byref<'T> when 'T :> IAsyncStateMachine) = x.MoveNext() - -type taskSeq<'T> = IAsyncEnumerable<'T> - -type IPriority1 = interface end -type IPriority2 = interface end - -[] -type TaskSeqStateMachineData<'T>() = - [] - val mutable cancellationToken : CancellationToken - [] - val mutable disposalStack : ResizeArray<(unit -> Task)> - [] - val mutable awaiter : ICriticalNotifyCompletion - [] - val mutable promiseOfValueOrEnd: ManualResetValueTaskSourceCore - [] - val mutable builder : AsyncIteratorMethodBuilder - [] - val mutable taken : bool - [] - val mutable current : ValueOption<'T> - [] - val mutable boxed: TaskSeq<'T> - // For tailcalls using 'return!' - [] - val mutable tailcallTarget: TaskSeq<'T> option - - member data.PushDispose (f: unit -> Task) = - match data.disposalStack with - | null -> data.disposalStack <- ResizeArray() - | _ -> () - data.disposalStack.Add(f) - - member data.PopDispose () = - match data.disposalStack with - | null -> () - | _ -> - data.disposalStack.RemoveAt(data.disposalStack.Count - 1) - -and [] - TaskSeq<'T>() = - abstract TailcallTarget: TaskSeq<'T> option - abstract MoveNextAsyncResult: unit -> ValueTask - - // F# requires that we implement interfaces even on an abstract class - interface IAsyncEnumerator<'T> with - member _.Current = failwith "abstract" - member _.MoveNextAsync() = failwith "abstract" - interface IAsyncDisposable with - member _.DisposeAsync() = failwith "abstract" - interface IAsyncEnumerable<'T> with - member _.GetAsyncEnumerator(ct) = failwith "abstract" - interface IAsyncStateMachine with - member _.MoveNext() = failwith "abstract" - member _.SetStateMachine(_state) = failwith "abstract" - interface IValueTaskSource with - member _.GetResult(_token: int16) = failwith "abstract" - member _.GetStatus(_token: int16) = failwith "abstract" - member _.OnCompleted(_continuation, _state, _token, _flags) = failwith "abstract" - interface IValueTaskSource with - member _.GetStatus(_token: int16) = failwith "abstract" - member _.GetResult(_token: int16) = failwith "abstract" - member _.OnCompleted(_continuation, _state, _token, _flags) = failwith "abstract" - -and [] - TaskSeq<'Machine, 'T when 'Machine :> IAsyncStateMachine and 'Machine :> IResumableStateMachine>>() = - inherit TaskSeq<'T>() - let initialThreadId = Environment.CurrentManagedThreadId - - [] - val mutable Machine : 'Machine - - member internal ts.hijack() = - let res = ts.Machine.Data.tailcallTarget - match res with - | Some tg -> - match tg.TailcallTarget with - | None -> - res - | (Some tg2 as res2) -> - // Cut out chains of tailcalls - ts.Machine.Data.tailcallTarget <- Some tg2 - res2 - | None -> - res - - // Note: Not entirely clear if this is needed, everything still compiles without it - interface IValueTaskSource with - member ts.GetResult(token: int16) = - match ts.hijack() with - | Some tg -> (tg :> IValueTaskSource).GetResult(token) - | None -> ts.Machine.Data.promiseOfValueOrEnd.GetResult(token) |> ignore - member ts.GetStatus(token: int16) = - match ts.hijack() with - | Some tg -> (tg :> IValueTaskSource).GetStatus(token) - | None -> ts.Machine.Data.promiseOfValueOrEnd.GetStatus(token) - member ts.OnCompleted(continuation, state, token, flags) = - match ts.hijack() with - | Some tg -> (tg :> IValueTaskSource).OnCompleted(continuation, state, token, flags) - | None -> ts.Machine.Data.promiseOfValueOrEnd.OnCompleted(continuation, state, token, flags) - - // Needed for MoveNextAsync to return a ValueTask - interface IValueTaskSource with - member ts.GetStatus(token: int16) = - match ts.hijack() with - | Some tg -> (tg :> IValueTaskSource).GetStatus(token) - | None -> ts.Machine.Data.promiseOfValueOrEnd.GetStatus(token) - member ts.GetResult(token: int16) = - match ts.hijack() with - | Some tg -> (tg :> IValueTaskSource).GetResult(token) - | None -> ts.Machine.Data.promiseOfValueOrEnd.GetResult(token) - member ts.OnCompleted(continuation, state, token, flags) = - match ts.hijack() with - | Some tg -> (tg :> IValueTaskSource).OnCompleted(continuation, state, token, flags) - | None -> ts.Machine.Data.promiseOfValueOrEnd.OnCompleted(continuation, state, token, flags) - - interface IAsyncStateMachine with - member ts.MoveNext() = - match ts.hijack() with - | Some tg -> (tg :> IAsyncStateMachine).MoveNext() - | None -> MoveNext(&ts.Machine) - - member _.SetStateMachine(_state) = () // not needed for reference type - - interface IAsyncEnumerable<'T> with - member ts.GetAsyncEnumerator(ct) = - let data = ts.Machine.Data - if (not data.taken && initialThreadId = Environment.CurrentManagedThreadId) then - data.taken <- true - data.cancellationToken <- ct - data.builder <- AsyncIteratorMethodBuilder.Create() - (ts :> IAsyncEnumerator<_>) - else - if verbose then printfn "GetAsyncEnumerator, cloning..." - let clone = ts.MemberwiseClone() :?> TaskSeq<'Machine, 'T> - data.taken <- true - clone.Machine.Data.cancellationToken <- ct - (clone :> System.Collections.Generic.IAsyncEnumerator<'T>) - - interface IAsyncDisposable with - member ts.DisposeAsync() = - match ts.hijack() with - | Some tg -> (tg :> IAsyncDisposable).DisposeAsync() - | None -> - if verbose then printfn "DisposeAsync..." - task { - match ts.Machine.Data.disposalStack with - | null -> () - | _ -> - let mutable exn = None - for d in Seq.rev ts.Machine.Data.disposalStack do - try - do! d() - with e -> - if exn.IsNone then - exn <- Some e - match exn with - | None -> () - | Some e -> raise e - } - |> ValueTask - - interface System.Collections.Generic.IAsyncEnumerator<'T> with - member ts.Current = - match ts.hijack() with - | Some tg -> (tg :> IAsyncEnumerator<'T>).Current - | None -> - match ts.Machine.Data.current with - | ValueSome x -> x - | ValueNone -> failwith "no current value" - - member ts.MoveNextAsync() = - match ts.hijack() with - | Some tg -> (tg :> IAsyncEnumerator<'T>).MoveNextAsync() - | None -> - if verbose then printfn "MoveNextAsync..." - if ts.Machine.ResumptionPoint = -1 then // can't use as IAsyncEnumerator before IAsyncEnumerable - ValueTask() - else - let data = ts.Machine.Data - data.promiseOfValueOrEnd.Reset() - let mutable ts = ts - data.builder.MoveNext(&ts) - - // If the move did a hijack then get the result from the final one - match ts.hijack() with - | Some tg -> tg.MoveNextAsyncResult() - | None -> ts.MoveNextAsyncResult() - - override ts.MoveNextAsyncResult() = - let data = ts.Machine.Data - let version = data.promiseOfValueOrEnd.Version - let status = data.promiseOfValueOrEnd.GetStatus(version) - if status = ValueTaskSourceStatus.Succeeded then - let result = data.promiseOfValueOrEnd.GetResult(version) - ValueTask(result) - else - if verbose then printfn "MoveNextAsync pending/faulted/cancelled..." - ValueTask(ts, version) // uses IValueTaskSource<'T> - - override cr.TailcallTarget = - cr.hijack() - -and TaskSeqCode<'T> = ResumableCode, unit> -and TaskSeqStateMachine<'T> = ResumableStateMachine> -and TaskSeqResumptionFunc<'T> = ResumptionFunc> -and TaskSeqResumptionDynamicInfo<'T> = ResumptionDynamicInfo> - -type TaskSeqBuilder() = - - member inline _.Delay(f : unit -> TaskSeqCode<'T>) : TaskSeqCode<'T> = - TaskSeqCode<'T>(fun sm -> f().Invoke(&sm)) - - member inline _.Run(code : TaskSeqCode<'T>) : IAsyncEnumerable<'T> = - if __useResumableCode then - // This is the static implementation. A new struct type is created. - __stateMachine, IAsyncEnumerable<'T>> - // IAsyncStateMachine.MoveNext - (MoveNextMethodImpl<_>(fun sm -> - //-- RESUMABLE CODE START - __resumeAt sm.ResumptionPoint - try - //printfn "at Run.MoveNext start" - //Console.WriteLine("[{0}] resuming by invoking {1}....", sm.MethodBuilder.Task.Id, hashq sm.ResumptionFunc ) - let __stack_code_fin = code.Invoke(&sm) - //printfn $"at Run.MoveNext, __stack_code_fin={__stack_code_fin}" - if __stack_code_fin then - //printfn $"at Run.MoveNext, done" - sm.Data.promiseOfValueOrEnd.SetResult(false) - sm.Data.builder.Complete() - elif sm.Data.current.IsSome then - //printfn $"at Run.MoveNext, yield" - sm.Data.promiseOfValueOrEnd.SetResult(true) - else - // Goto request - match sm.Data.tailcallTarget with - | Some tg -> - //printfn $"at Run.MoveNext, hijack" - let mutable tg = tg - MoveNext(&tg) - | None -> - //printfn $"at Run.MoveNext, await" - let boxed = sm.Data.boxed - sm.Data.awaiter.UnsafeOnCompleted(Action(fun () -> - let mutable boxed = boxed - MoveNext(&boxed))) - - with exn -> - //Console.WriteLine("[{0}] SetException {1}", sm.MethodBuilder.Task.Id, exn) - sm.Data.promiseOfValueOrEnd.SetException(exn) - sm.Data.builder.Complete() - //-- RESUMABLE CODE END - )) - (SetStateMachineMethodImpl<_>(fun sm state -> ())) - (AfterCode<_,_>(fun sm -> - let ts = TaskSeq, 'T>() - ts.Machine <- sm - ts.Machine.Data <- TaskSeqStateMachineData() - ts.Machine.Data.boxed <- ts - ts :> IAsyncEnumerable<'T>)) - else - failwith "no dynamic implementation as yet" - // let initialResumptionFunc = TaskSeqResumptionFunc<'T>(fun sm -> code.Invoke(&sm)) - // let resumptionFuncExecutor = TaskSeqResumptionExecutor<'T>(fun sm f -> - // // TODO: add exception handling? - // if f.Invoke(&sm) then - // sm.ResumptionPoint <- -2) - // let setStateMachine = SetStateMachineMethodImpl<_>(fun sm f -> ()) - // sm.Machine.ResumptionFuncInfo <- (initialResumptionFunc, resumptionFuncExecutor, setStateMachine) - //sm.Start() - - - member inline _.Zero() : TaskSeqCode<'T> = - ResumableCode.Zero() - - member inline _.Combine(task1: TaskSeqCode<'T>, task2: TaskSeqCode<'T>) : TaskSeqCode<'T> = - ResumableCode.Combine(task1, task2) - - member inline _.WhileAsync([] condition : unit -> ValueTask, body : TaskSeqCode<'T>) : TaskSeqCode<'T> = - let mutable condition_res = true - ResumableCode.While((fun () -> condition_res), - ResumableCode<_,_>(fun sm -> - let mutable __stack_condition_fin = true - let __stack_vtask = condition() - if __stack_vtask.IsCompleted then - __stack_condition_fin <- true - condition_res <- __stack_vtask.Result - else - let task = __stack_vtask.AsTask() - let mutable awaiter = task.GetAwaiter() - // This will yield with __stack_fin = false - // This will resume with __stack_fin = true - let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) - __stack_condition_fin <- __stack_yield_fin - - if __stack_condition_fin then - condition_res <- task.Result - else - //if verbose then printfn "calling AwaitUnsafeOnCompleted" - sm.Data.awaiter <- awaiter - sm.Data.current <- ValueNone - - if __stack_condition_fin then - if condition_res then - body.Invoke(&sm) - else - true - else - false - )) - - member inline b.While([] condition : unit -> bool, body : TaskSeqCode<'T>) : TaskSeqCode<'T> = - b.WhileAsync((fun () -> ValueTask(condition())), body) - - member inline _.TryWith(body : TaskSeqCode<'T>, catch : exn -> TaskSeqCode<'T>) : TaskSeqCode<'T> = - ResumableCode.TryWith(body, catch) - - member inline _.TryFinallyAsync(body: TaskSeqCode<'T>, compensation : unit -> Task) : TaskSeqCode<'T> = - ResumableCode.TryFinallyAsync( - TaskSeqCode<'T>(fun sm -> - sm.Data.PushDispose (fun () -> compensation()) - body.Invoke(&sm)), - ResumableCode<_,_>(fun sm -> - sm.Data.PopDispose(); - let mutable __stack_condition_fin = true - let __stack_vtask = compensation() - if not __stack_vtask.IsCompleted then - let mutable awaiter = __stack_vtask.GetAwaiter() - let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) - __stack_condition_fin <- __stack_yield_fin - - if not __stack_condition_fin then - sm.Data.awaiter <- awaiter - - __stack_condition_fin)) - - member inline _.TryFinally(body: TaskSeqCode<'T>, compensation : unit -> unit) : TaskSeqCode<'T> = - ResumableCode.TryFinally( - TaskSeqCode<'T>(fun sm -> - sm.Data.PushDispose (fun () -> compensation(); Task.CompletedTask) - body.Invoke(&sm)), - ResumableCode<_,_>(fun sm -> sm.Data.PopDispose(); compensation(); true)) - - member inline this.Using(disp : #IDisposable, body : #IDisposable -> TaskSeqCode<'T>, ?priority: IPriority2) : TaskSeqCode<'T> = - ignore priority - // A using statement is just a try/finally with the finally block disposing if non-null. - this.TryFinally( - (fun sm -> (body disp).Invoke(&sm)), - (fun () -> if not (isNull (box disp)) then disp.Dispose())) - - member inline this.Using(disp : #IAsyncDisposable, body : #IAsyncDisposable -> TaskSeqCode<'T>, ?priority: IPriority1) : TaskSeqCode<'T> = - ignore priority - // A using statement is just a try/finally with the finally block disposing if non-null. - this.TryFinallyAsync( - (fun sm -> (body disp).Invoke(&sm)), - (fun () -> - if not (isNull (box disp)) then - disp.DisposeAsync().AsTask() - else - Task.CompletedTask)) - - member inline this.For(sequence : seq<'TElement>, body : 'TElement -> TaskSeqCode<'T>) : TaskSeqCode<'T> = - // A for loop is just a using statement on the sequence's enumerator... - this.Using (sequence.GetEnumerator(), - // ... and its body is a while loop that advances the enumerator and runs the body on each element. - (fun e -> this.While((fun () -> e.MoveNext()), (fun sm -> (body e.Current).Invoke(&sm))))) - - member inline this.For(source: #IAsyncEnumerable<'TElement>, body : 'TElement -> TaskSeqCode<'T>) : TaskSeqCode<'T> = - TaskSeqCode<'T>(fun sm -> - this.Using(source.GetAsyncEnumerator(sm.Data.cancellationToken), - (fun e -> this.WhileAsync((fun () -> e.MoveNextAsync()), - (fun sm -> (body e.Current).Invoke(&sm))))).Invoke(&sm)) - - member inline _.Yield (v: 'T) : TaskSeqCode<'T> = - TaskSeqCode<'T>(fun sm -> - // This will yield with __stack_fin = false - // This will resume with __stack_fin = true - let __stack_fin = ResumableCode.Yield().Invoke(&sm) - sm.Data.current <- ValueSome v - sm.Data.awaiter <- null - __stack_fin) - - member inline this.YieldFrom (source: IAsyncEnumerable<'T>) : TaskSeqCode<'T> = - this.For(source, (fun v -> this.Yield(v))) - - member inline _.Bind (task: Task<'TResult1>, continuation: ('TResult1 -> TaskSeqCode<'T>)) : TaskSeqCode<'T> = - TaskSeqCode<'T>(fun sm -> - let mutable awaiter = task.GetAwaiter() - let mutable __stack_fin = true - if not awaiter.IsCompleted then - // This will yield with __stack_fin2 = false - // This will resume with __stack_fin2 = true - let __stack_fin2 = ResumableCode.Yield().Invoke(&sm) - __stack_fin <- __stack_fin2 - - if __stack_fin then - let result = awaiter.GetResult() - (continuation result).Invoke(&sm) - else - if verbose then printfn "calling AwaitUnsafeOnCompleted" - sm.Data.awaiter <- awaiter - sm.Data.current <- ValueNone - false) - - // TODO: using return! for tailcalls is wrong. We should use yield! and have F# - // desugar to a different builder method when in tailcall position - // - // Because of this using return! from non-tailcall position e.g. in a try-finally or try-with will - // giv incorrect results (escaping the exception handler - 'close up shop and draw results from somewhere else') - member inline b.ReturnFrom (other: IAsyncEnumerable<'T>) : TaskSeqCode<'T> = - TaskSeqCode<_>(fun sm -> - match other with - | :? TaskSeq<'T> as other -> - sm.Data.tailcallTarget <- Some other - sm.Data.awaiter <- null - sm.Data.current <- ValueNone - // For tailcalls we return 'false' and re-run from the entry (trampoline) - false - | _ -> - b.YieldFrom(other).Invoke(&sm) - ) - -let taskSeq = TaskSeqBuilder() - -module TaskSeq = - let toList (t: taskSeq<'T>) = - [ let e = t.GetAsyncEnumerator(CancellationToken()) - try - while (let vt = e.MoveNextAsync() in if vt.IsCompleted then vt.Result else vt.AsTask().Result) do - yield e.Current - finally - e.DisposeAsync().AsTask().Wait() ] - - let toArray (t: taskSeq<'T>) = - [| let e = t.GetAsyncEnumerator(CancellationToken()) - try - while (let vt = e.MoveNextAsync() in if vt.IsCompleted then vt.Result else vt.AsTask().Result) do - yield e.Current - finally - e.DisposeAsync().AsTask().Wait() |] - - let toArrayAsync (t: taskSeq<'T>) : Task<'T[]> = - task { - let res = ResizeArray<'T>() - let e = t.GetAsyncEnumerator(CancellationToken()) - let mutable go = true - let! step = e.MoveNextAsync() - go <- step - while go do - res.Add e.Current - if verbose then printfn "yield %A" e.Current - let! step = e.MoveNextAsync() - go <- step - return res.ToArray() - } - - let iter f (t: taskSeq<'T>) = - let e = t.GetAsyncEnumerator(CancellationToken()) - try - while (let vt = e.MoveNextAsync() in if vt.IsCompleted then vt.Result else vt.AsTask().Result) do - f e.Current - finally - e.DisposeAsync().AsTask().Wait() - -module Examples = - - let t1 () = - taskSeq { - printfn "in t1" - yield "a" - let x = 1 - let! v = - task { - printfn "hey" - do! Task.Delay(10) - } - yield "b" - let! v = - task { - printfn "hey yo" - do! Task.FromResult(()) - } - yield "c" - let! v = - task { - printfn "and a bottle of rum" - do! Task.Delay(0) - } - yield "d" - } - - let testTailcallTiny () = - taskSeq { - return! t1() - } - let rec testTailcall (n: int) = - taskSeq { - if n % 100 = 0 then printfn $"in t1, n = {n}" - yield n - if n > 0 then - return! testTailcall(n-1) - //yield () - } - - //let t2 () = - // taskSeq { - // printfn "in t2" - // yield "d" - // printfn "in t2 b" - // for x in t1 () do - // printfn "t2 - got %A" x - // yield "e" - // let! v = - // task { - // printfn "hey yo" - // do! Task.Delay(200) - // } - // yield "[T1]" + x - // let! v = - // task { - // printfn "hey yo" - // do! Task.Delay(10) - // } - // yield "f" - // } - - let perf1 (x: int) = - taskSeq { - yield 1 - yield 2 - if x >= 2 then - yield 3 - yield 4 - } - - let perf2 () = - taskSeq { - for i1 in perf1 3 do - for i2 in perf1 3 do - for i3 in perf1 3 do - for i4 in perf1 3 do - for i5 in perf1 3 do - yield! perf1 i5 - } - - //let perf1_AsyncSeq (x: int) = - // FSharp.Control.AsyncSeqExtensions.asyncSeq { - // yield 1 - // yield 2 - // if x >= 2 then - // yield 3 - // yield 4 - // } - - //let perf2_AsyncSeq () = - // FSharp.Control.AsyncSeqExtensions.asyncSeq { - // for i1 in perf1_AsyncSeq 3 do - // for i2 in perf1_AsyncSeq 3 do - // for i3 in perf1_AsyncSeq 3 do - // for i4 in perf1_AsyncSeq 3 do - // for i5 in perf1_AsyncSeq 3 do - // yield! perf1_AsyncSeq i5 - // } - - let dumpTaskSeq (t: IAsyncEnumerable<_>) = - printfn "-----" - let e = t.GetAsyncEnumerator(CancellationToken()) - while (let vt = e.MoveNextAsync() in if vt.IsCompleted then vt.Result else vt.AsTask().Result) do - printfn "yield %A" e.Current - - //dumpTaskSeq (t1()) - //dumpTaskSeq (testTailcallTiny()) - ////dumpTaskSeq (t2()) - - //printfn "t1() = %A" (TaskSeq.toArray (t1())) - //printfn "testTailcallTiny() = %A" (TaskSeq.toArray (testTailcallTiny())) - //dumpTaskSeq (testTailcall(100000)) - //printfn "t2() = %A" (TaskSeq.toArray (t2())) - - printfn "perf2() = %A" (TaskSeq.toArray (perf2()) |> Array.sum) - diff --git a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerfCSharp/TaskPerfCSharp.cs b/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerfCSharp/TaskPerfCSharp.cs deleted file mode 100644 index 32ea6fcb66c..00000000000 --- a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerfCSharp/TaskPerfCSharp.cs +++ /dev/null @@ -1,125 +0,0 @@ -using System; -using System.Collections.Generic; -using System.Diagnostics; -using System.IO; -using System.Threading.Tasks; - -#pragma warning disable 1998 - -public static class TaskPerfCSharp -{ - public const int BufferSize = 128; - //public const int ManyIterations = 10000; - - public static async Task ManyWriteFileAsync(int ManyIterations) - { - const string path = "tmp"; - var junk = new byte[BufferSize]; - using (var file = File.Create(path)) - { - for (var i = 1; i <= ManyIterations; i++) - { - await file.WriteAsync(junk, 0, junk.Length); - } - } - File.Delete(path); - } - - public static System.Runtime.CompilerServices.YieldAwaitable AsyncTask() - { - return Task.Yield(); - } - - public static Task SyncTask() - { - return Task.FromResult(100); - } - - public static async Task TenBindsSync_CSharp() - { - var x1 = await SyncTask(); - var x2 = await SyncTask(); - var x3 = await SyncTask(); - var x4 = await SyncTask(); - var x5 = await SyncTask(); - var x6 = await SyncTask(); - var x7 = await SyncTask(); - var x8 = await SyncTask(); - var x9 = await SyncTask(); - var x10 = await SyncTask(); - return x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 + x10; - } - - public static async Task TenBindsAsync_CSharp() - { - await AsyncTask(); - await AsyncTask(); - await AsyncTask(); - await AsyncTask(); - await AsyncTask(); - await AsyncTask(); - await AsyncTask(); - await AsyncTask(); - await AsyncTask(); - await AsyncTask(); - return 100; - } - - public static async Task SingleSyncTask_CSharp() - { - return 1; - } - - public static async Task SingleSyncExceptionTask_CSharp() - { - throw (new System.Exception("fail")); - } - - - public static async IAsyncEnumerable perf1_AsyncEnumerable(int x) - { - yield return 1; - yield return 2; - if (x >= 2) - { - yield return 3; - yield return 4; - } - } - - public static async IAsyncEnumerable perf2_AsyncEnumerable() - { - await foreach (var i1 in perf1_AsyncEnumerable(3)) - { - await foreach (var i2 in perf1_AsyncEnumerable(3)) - { - await foreach (var i3 in perf1_AsyncEnumerable(3)) - { - await foreach (var i4 in perf1_AsyncEnumerable(3)) - { - await foreach (var i5 in perf1_AsyncEnumerable(3)) - { - await foreach (var i6 in perf1_AsyncEnumerable(i5)) - { - yield return i6; - - } - } - - } - - } - - } - - } - } - -#if MAIN - public static void Main() { - var t = SingleSyncExceptionTask_CSharp(); - System.Console.WriteLine("t = {0}", t); - } -#endif -} - diff --git a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerfCSharp/TaskPerfCSharp.csproj b/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerfCSharp/TaskPerfCSharp.csproj deleted file mode 100644 index 29148a7450d..00000000000 --- a/tests/benchmarks/CompiledCodeBenchmarks/TaskPerf/TaskPerfCSharp/TaskPerfCSharp.csproj +++ /dev/null @@ -1,19 +0,0 @@ - - - - $(FSharpNetCoreProductTargetFramework) - Library - 8.0 - - - - - $(NoWarn);CS1591 - - - - - - - - diff --git a/tests/benchmarks/Directory.Build.props b/tests/benchmarks/Directory.Build.props new file mode 100644 index 00000000000..ba9f0b7a4fa --- /dev/null +++ b/tests/benchmarks/Directory.Build.props @@ -0,0 +1,8 @@ + + + + + true + $(FSharpNetCoreProductTargetFramework) + + diff --git a/tests/benchmarks/FCSBenchmarks/BenchmarkComparison/HistoricalBenchmark.Runner/HistoricalBenchmark.Runner.fsproj b/tests/benchmarks/FCSBenchmarks/BenchmarkComparison/HistoricalBenchmark.Runner/HistoricalBenchmark.Runner.fsproj index 1781b4784dc..cc42c675f31 100644 --- a/tests/benchmarks/FCSBenchmarks/BenchmarkComparison/HistoricalBenchmark.Runner/HistoricalBenchmark.Runner.fsproj +++ b/tests/benchmarks/FCSBenchmarks/BenchmarkComparison/HistoricalBenchmark.Runner/HistoricalBenchmark.Runner.fsproj @@ -1,18 +1,17 @@ - + - $(FSharpNetCoreProductTargetFramework) - true - HistoricalBenchmark.Utilities - $(NoWarn);NETSDK1206 + true + HistoricalBenchmark.Utilities + $(NoWarn);NETSDK1206 - + - + diff --git a/tests/benchmarks/FCSBenchmarks/BenchmarkComparison/HistoricalBenchmark.fsproj b/tests/benchmarks/FCSBenchmarks/BenchmarkComparison/HistoricalBenchmark.fsproj index 48cfa7b4975..2440c65d727 100644 --- a/tests/benchmarks/FCSBenchmarks/BenchmarkComparison/HistoricalBenchmark.fsproj +++ b/tests/benchmarks/FCSBenchmarks/BenchmarkComparison/HistoricalBenchmark.fsproj @@ -2,8 +2,6 @@ Exe - $(FSharpNetCoreProductTargetFramework) - true Release diff --git a/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/FSharp.Compiler.Benchmarks.fsproj b/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/FSharp.Compiler.Benchmarks.fsproj index c7a873a2cc4..4c66d9cfb87 100644 --- a/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/FSharp.Compiler.Benchmarks.fsproj +++ b/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/FSharp.Compiler.Benchmarks.fsproj @@ -2,8 +2,6 @@ Exe - $(FSharpNetCoreProductTargetFramework) - true false diff --git a/tests/benchmarks/FCSBenchmarks/FCSSourceFiles/FCSSourceFiles.fsproj b/tests/benchmarks/FCSBenchmarks/FCSSourceFiles/FCSSourceFiles.fsproj index 265ab45ac19..a400d5fbad3 100644 --- a/tests/benchmarks/FCSBenchmarks/FCSSourceFiles/FCSSourceFiles.fsproj +++ b/tests/benchmarks/FCSBenchmarks/FCSSourceFiles/FCSSourceFiles.fsproj @@ -2,8 +2,6 @@ Exe - $(FSharpNetCoreProductTargetFramework) - true @@ -11,7 +9,7 @@ - + diff --git a/tests/benchmarks/FSharp.Benchmarks.Common/FSharp.Benchmarks.Common.fsproj b/tests/benchmarks/FSharp.Benchmarks.Common/FSharp.Benchmarks.Common.fsproj index 615a5ab3a77..03f8e031a9a 100644 --- a/tests/benchmarks/FSharp.Benchmarks.Common/FSharp.Benchmarks.Common.fsproj +++ b/tests/benchmarks/FSharp.Benchmarks.Common/FSharp.Benchmarks.Common.fsproj @@ -1,10 +1,5 @@  - - $(FSharpNetCoreProductTargetFramework) - true - -