Skip to content

Commit

Permalink
+ Result.Sequence & Option|VOption use Accumulator
Browse files Browse the repository at this point in the history
Also update Traverse
  • Loading branch information
fcallejon committed Nov 15, 2023
1 parent 1970fea commit 0265e5f
Show file tree
Hide file tree
Showing 5 changed files with 262 additions and 15 deletions.
2 changes: 1 addition & 1 deletion src/FSharpPlus/Control/Traversable.fs
Original file line number Diff line number Diff line change
Expand Up @@ -4,14 +4,14 @@

open System.Runtime.InteropServices
open System.ComponentModel
open Microsoft.FSharp.Core.CompilerServices
open FSharpPlus
open FSharpPlus.Data
open FSharpPlus.Internals
open FSharpPlus.Internals.Prelude
open FSharpPlus.Internals.MonadOps
open FSharpPlus.Extensions


type Sequence =
inherit Default1
static member inline InvokeOnInstance (t: '``Traversable<Functor<'T>>``) = (^``Traversable<Functor<'T>>`` : (static member Sequence : _ -> _) t) : '``Functor<'Traversable<'T>>``
Expand Down
93 changes: 83 additions & 10 deletions src/FSharpPlus/Extensions/Extensions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -126,7 +126,8 @@ module Extensions =
type Option<'t> with

/// Returns None if it contains a None element, otherwise a list of all elements
static member Sequence (t: seq<option<'T>>) =
static member Sequence (t: seq<option<'t>>) =
#if FABLE_COMPILER
let mutable ok = true
let res = Seq.toArray (seq {
use e = t.GetEnumerator ()
Expand All @@ -135,11 +136,26 @@ module Extensions =
| Some v -> yield v
| None -> ok <- false })
if ok then Some (Array.toSeq res) else None

#else
let mutable accumulator = ArrayCollector<'t> ()
let mutable noneFound = false
use e = t.GetEnumerator ()
while e.MoveNext () && noneFound do
match e.Current with
| Some v -> accumulator.Add v
| None -> noneFound <- true

if noneFound
then None
else
Some (accumulator.Close () |> Array.toSeq)
#endif

type ValueOption<'t> with

/// Returns None if it contains a None element, otherwise a list of all elements
static member Sequence (t: seq<voption<'T>>) =
static member Sequence (t: seq<voption<'t>>) =
#if FABLE_COMPILER
let mutable ok = true
let res = Seq.toArray (seq {
use e = t.GetEnumerator ()
Expand All @@ -148,18 +164,75 @@ module Extensions =
| ValueSome v -> yield v
| ValueNone -> ok <- false })
if ok then ValueSome (Array.toSeq res) else ValueNone
#else
let mutable accumulator = ArrayCollector<'t> ()
let mutable noneFound = false
use e = t.GetEnumerator ()
while e.MoveNext () && noneFound do
match e.Current with
| ValueSome v -> accumulator.Add v
| ValueNone -> noneFound <- true

if noneFound
then ValueNone
else
ValueSome (accumulator.Close () |> Array.toSeq)
#endif

type Choice<'t, 'error> with

/// Returns the first Error if it contains an Error element, otherwise a list of all elements
static member Sequence (t: seq<Choice<_, _>>) =
#if FABLE_COMPILER
let mutable error = ValueNone
let res = Seq.toArray (seq {
use e = t.GetEnumerator ()
while e.MoveNext () && error.IsNone do
match e.Current with
| Choice1Of2 v -> yield v
| Choice2Of2 e -> error <- ValueSome e })

match error with
| ValueNone -> Choice1Of2 (Array.toSeq res)
| ValueSome e -> Choice2Of2 e
#else
let mutable accumulator = ArrayCollector<'t> ()
let mutable error = ValueNone
use e = t.GetEnumerator ()
while e.MoveNext () && error.IsNone do
match e.Current with
| Choice1Of2 v -> accumulator.Add v
| Choice2Of2 x -> error <- ValueSome x
match error with
| ValueNone -> Choice1Of2 (accumulator.Close () |> Array.toSeq)
| ValueSome x -> Choice2Of2 x
#endif

type Result<'t, 'error> with

/// Returns the first Error if it contains an Error element, otherwise a list of all elements
static member Sequence (t: seq<Result<'T, ' Error>>) =
let mutable bad = None
static member Sequence (t: seq<Result<_, _>>) =
#if FABLE_COMPILER
let mutable error = ValueNone
let res = Seq.toArray (seq {
use e = t.GetEnumerator ()
while e.MoveNext () && bad.IsNone do
while e.MoveNext () && error.IsNone do
match e.Current with
| Ok v -> yield v
| Error x -> bad <- Some x })
match bad with
| None-> Ok (Array.toSeq res)
| Some x -> Error x
| Error e -> error <- ValueSome e })

match error with
| ValueNone -> Ok (Array.toSeq res)
| ValueSome e -> Error e
#else
let mutable accumulator = ArrayCollector<'t> ()
let mutable error = ValueNone
use e = t.GetEnumerator ()
while e.MoveNext () && error.IsNone do
match e.Current with
| Ok v -> accumulator.Add v
| Error x -> error <- ValueSome x
match error with
| ValueNone -> Ok (accumulator.Close () |> Array.toSeq)
| ValueSome x -> Error x
#endif
4 changes: 4 additions & 0 deletions tests/benchmarks/Benchmarks.fsproj
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,10 @@
</ItemGroup>
<ItemGroup>
<Compile Include="AsyncSequenceBenchmarks.fs" />
<Compile Include="ExtensionsBenchmarks.fs" />
<Compile Include="Program.fs" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\..\src\FSharpPlus\FSharpPlus.fsproj" />
</ItemGroup>
</Project>
170 changes: 170 additions & 0 deletions tests/benchmarks/ExtensionsBenchmarks.fs
Original file line number Diff line number Diff line change
@@ -0,0 +1,170 @@
module ExtensionsBenchmarks

open FSharpPlus
open BenchmarkDotNet.Attributes
open Microsoft.FSharp.Core.CompilerServices

[<AutoOpen>]
module Common =
let mkArray s n invalidAtEnd arraySize =
if invalidAtEnd then
seq {
yield! Array.init arraySize (fun _ -> s(1))
yield n
}
|> Seq.toArray
else
seq {
yield! Array.init (arraySize / 2) (fun _ -> s(1))
yield n
yield! Array.init (arraySize / 2) (fun _ -> s(1))
}
|> Seq.toArray

module OptionOldVersion =
let sequence (t: seq<option<'T>>) =
let mutable ok = true
let res = Seq.toArray (seq {
use e = t.GetEnumerator ()
while e.MoveNext () && ok do
match e.Current with
| Some v -> yield v
| None -> ok <- false })
if ok then Some (Array.toSeq res) else None

module VOptionOldVersion =
let sequence (t: seq<voption<'T>>) =
let mutable ok = true
let res = Seq.toArray (seq {
use e = t.GetEnumerator ()
while e.MoveNext () && ok do
match e.Current with
| ValueSome v -> yield v
| ValueNone -> ok <- false })
if ok then ValueSome (Array.toSeq res) else ValueNone

module OptionNewVersion =

let sequence (t: seq<option<'T>>) =
let mutable accumulator = ArrayCollector<'T> ()
let mutable noneFound = false
use e = t.GetEnumerator ()
while e.MoveNext () && noneFound do
match e.Current with
| Some v -> accumulator.Add v
| None -> noneFound <- true

if noneFound
then None
else
Some (accumulator.Close () |> Array.toSeq)

module VOptionNewVersion =

let sequence (t: seq<voption<'T>>) =
let mutable accumulator = ArrayCollector<'T> ()
let mutable noneFound = false
use e = t.GetEnumerator ()
while e.MoveNext () && noneFound do
match e.Current with
| ValueSome v -> accumulator.Add v
| ValueNone -> noneFound <- true

if noneFound
then ValueNone
else
ValueSome (accumulator.Close () |> Array.toSeq)

module ResultOldVersion =
let sequence (t: seq<Result<_, _>>) =
let mutable error = None
let res = Seq.toArray (seq {
use e = t.GetEnumerator ()
while e.MoveNext () && error.IsNone do
match e.Current with
| Ok v -> yield v
| Error e -> error <- Some e })

match error with
| None -> Ok (Array.toSeq res)
| Some e -> Error e

module ResultNewVersion =

let sequence (t: seq<Result<int, string>>) : Result<int seq, string> =
let mutable accumulator = ArrayCollector<'T> ()
let mutable error = None
use e = t.GetEnumerator ()
while e.MoveNext () && error.IsNone do
match e.Current with
| Ok v -> accumulator.Add v
| Error e -> error <- Some e

match error with
| None -> Ok (accumulator.Close () |> Array.toSeq)
| Some e -> Error e

type Values<'t> = { Title: string; Values: 't }

[<MemoryDiagnoser>]
type OptionBenchmarks() =

member this.runArray =
seq {
yield { Title = "1000_M"; Values = mkArray Some None false 1000 }
yield { Title = "10000_M"; Values = mkArray Some None false 10000 }
yield { Title = "100000_M"; Values = mkArray Some None false 100000 }
yield { Title = "1000_E"; Values = mkArray Some None true 1000 }
yield { Title = "10000_E"; Values = mkArray Some None true 10000 }
yield { Title = "100000_E"; Values = mkArray Some None true 100000 }
}

[<Benchmark(Baseline = true)>]
[<ArgumentsSource(nameof(Unchecked.defaultof<OptionBenchmarks>.runArray))>]
member this.Base (v: Values<int option array>) = OptionOldVersion.sequence v.Values

[<Benchmark>]
[<ArgumentsSource(nameof(Unchecked.defaultof<OptionBenchmarks>.runArray))>]
member this.NewVersion (v: Values<int option array>) = OptionNewVersion.sequence v.Values

[<MemoryDiagnoser>]
type VOptionBenchmarks() =

member this.runArray =
seq {
yield { Title = "1000_M"; Values = mkArray ValueSome ValueNone false 1000 }
yield { Title = "10000_M"; Values = mkArray ValueSome ValueNone false 10000 }
yield { Title = "100000_M"; Values = mkArray ValueSome ValueNone false 100000 }
yield { Title = "1000_E"; Values = mkArray ValueSome ValueNone true 1000 }
yield { Title = "10000_E"; Values = mkArray ValueSome ValueNone true 10000 }
yield { Title = "100000_E"; Values = mkArray ValueSome ValueNone true 100000 }
}

[<Benchmark(Baseline = true)>]
[<ArgumentsSource(nameof(Unchecked.defaultof<VOptionBenchmarks>.runArray))>]
member this.VOptionBase (v: Values<int voption array>) = VOptionOldVersion.sequence v.Values

[<Benchmark>]
[<ArgumentsSource(nameof(Unchecked.defaultof<VOptionBenchmarks>.runArray))>]
member this.NewVersion (v: Values<int voption array>) = VOptionNewVersion.sequence v.Values

[<MemoryDiagnoser>]
type ResultBenchmarks() =

member this.runArray =
seq {
yield { Title = "1000_M"; Values = mkArray Ok (Error "error") false 1000 }
yield { Title = "10000_M"; Values = mkArray Ok (Error "error") false 10000 }
yield { Title = "100000_M"; Values = mkArray Ok (Error "error") false 100000 }
yield { Title = "1000_E"; Values = mkArray Ok (Error "error") true 1000 }
yield { Title = "10000_E"; Values = mkArray Ok (Error "error") true 10000 }
yield { Title = "100000_E"; Values = mkArray Ok (Error "error") true 100000 }
}

[<Benchmark(Baseline = true)>]
[<ArgumentsSource(nameof(Unchecked.defaultof<ResultBenchmarks>.runArray))>]
member this.ResultBase (v: Values<Result<int, string> array>) = ResultOldVersion.sequence v.Values

[<Benchmark>]
[<ArgumentsSource(nameof(Unchecked.defaultof<ResultBenchmarks>.runArray))>]
member this.NewVersion (v: Values<Result<int, string> array>) = ResultNewVersion.sequence v.Values
8 changes: 4 additions & 4 deletions tests/benchmarks/Program.fs
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
open AsyncSequences

[<EntryPoint>]
let main _ =
do BenchmarkDotNet.Running.BenchmarkRunner.Run<Benchmarks>() |> ignore
0
// do BenchmarkDotNet.Running.BenchmarkRunner.Run<ExtensionsBenchmarks.OptionBenchmarks>() |> ignore
// do BenchmarkDotNet.Running.BenchmarkRunner.Run<ExtensionsBenchmarks.VOptionBenchmarks>() |> ignore
do BenchmarkDotNet.Running.BenchmarkRunner.Run<ExtensionsBenchmarks.ResultBenchmarks>() |> ignore
0

0 comments on commit 0265e5f

Please sign in to comment.