Skip to content

Commit

Permalink
Improve sequential traversals type inference (#596)
Browse files Browse the repository at this point in the history
  • Loading branch information
gusty authored Feb 12, 2024
1 parent 547874e commit 661a2c8
Show file tree
Hide file tree
Showing 4 changed files with 24 additions and 20 deletions.
32 changes: 18 additions & 14 deletions src/FSharpPlus/Control/Traversable.fs
Original file line number Diff line number Diff line change
Expand Up @@ -15,15 +15,19 @@ type Sequence =
static member inline InvokeOnInstance (t: '``Traversable<'Functor<'T>>``) = (^``Traversable<'Functor<'T>>`` : (static member Sequence : _ -> _) t) : '``Functor<'Traversable<'T>>``

[<EditorBrowsable(EditorBrowsableState.Never)>]
static member inline ForInfiniteSequences (t: seq<_>, isFailure, conversion) =
static member inline ForInfiniteSequences (t: seq<_>, [<InlineIfLambda>]isFailure, [<InlineIfLambda>]conversion, [<InlineIfLambda>]result) =
let add x y = y :: x
let mutable go = true
let mutable r = result []
let mutable r = Unchecked.defaultof<_>
let mutable isEmpty = true
use e = t.GetEnumerator ()
while go && e.MoveNext () do
if isFailure e.Current then go <- false
r <- Map.Invoke add r <*> e.Current
Map.Invoke (List.rev >> conversion) r
if isEmpty then r <- Map.Invoke List.singleton e.Current
else r <- Map.Invoke add r <*> e.Current
isEmpty <- false
if isEmpty then result (conversion [])
else Map.Invoke (List.rev >> conversion) r

type Traverse =
inherit Default1
Expand Down Expand Up @@ -63,14 +67,14 @@ type Traverse =
Traces.add "Traverse seq, 'T -> Functor<'U>"
#endif
let mapped = Seq.map f t
Sequence.ForInfiniteSequences (mapped, IsLeftZero.Invoke, List.toSeq) : '``Functor<seq<'U>>``
Sequence.ForInfiniteSequences (mapped, IsLeftZero.Invoke, List.toSeq, Return.Invoke) : '``Functor<seq<'U>>``

static member inline Traverse (t: NonEmptySeq<'T>, f: 'T -> '``Functor<'U>``, [<Optional>]_output: '``Functor<NonEmptySeq<'U>>``, [<Optional>]_impl: Default2) =
#if TEST_TRACE
Traces.add "Traverse NonEmptySeq, 'T -> Functor<'U>"
#endif
let mapped = NonEmptySeq.map f t
Sequence.ForInfiniteSequences (mapped, IsLeftZero.Invoke, NonEmptySeq.ofList) : '``Functor<NonEmptySeq<'U>>``
Sequence.ForInfiniteSequences (mapped, IsLeftZero.Invoke, NonEmptySeq.ofList, Return.Invoke) : '``Functor<NonEmptySeq<'U>>``

static member inline Traverse (t: ^a, f, [<Optional>]_output: 'R, [<Optional>]_impl: Default1) : 'R =
#if TEST_TRACE
Expand Down Expand Up @@ -186,26 +190,26 @@ type Sequence with
Seq.foldBack cons_f t (result Seq.empty)

static member inline Sequence (t: seq<'``Applicative<'T>``>, [<Optional>]_output: '``Applicative<seq<'T>>`` , [<Optional>]_impl: Default4) : '``Applicative<seq<'T>>`` =
Sequence.ForInfiniteSequences (t, IsLeftZero.Invoke, List.toSeq)
Sequence.ForInfiniteSequences (t, IsLeftZero.Invoke, List.toSeq, Return.Invoke)

static member Sequence (t: seq<option<'t>> , [<Optional>]_output: option<seq<'t>> , [<Optional>]_impl: Default3) : option<seq<'t>> = Option.Sequential t
#if !FABLE_COMPILER
static member Sequence (t: seq<voption<'t>> , [<Optional>]_output: voption<seq<'t>> , [<Optional>]_impl: Default3) : voption<seq<'t>> = ValueOption.Sequential t
#endif
static member Sequence (t: seq<Result<'t,'e>>, [<Optional>]_output: Result<seq<'t>, 'e>, [<Optional>]_impl: Default3) : Result<seq<'t>, 'e> = Result.Sequential t
static member Sequence (t: seq<Choice<'t,'e>>, [<Optional>]_output: Choice<seq<'t>, 'e>, [<Optional>]_impl: Default3) : Choice<seq<'t>, 'e> = Choice.Sequential t
static member Sequence (t: seq<list<'t>> , [<Optional>]_output: list<seq<'t>> , [<Optional>]_impl: Default3) : list<seq<'t>> = Sequence.ForInfiniteSequences (t, List.isEmpty, List.toSeq)
static member Sequence (t: seq<'t []> , [<Optional>]_output: seq<'t> [] , [<Optional>]_impl: Default3) : seq<'t> [] = Sequence.ForInfiniteSequences (t, Array.isEmpty, List.toSeq)
static member Sequence (t: seq<list<'t>> , [<Optional>]_output: list<seq<'t>> , [<Optional>]_impl: Default3) : list<seq<'t>> = Sequence.ForInfiniteSequences (t, List.isEmpty, List.toSeq, List.singleton)
static member Sequence (t: seq<'t []> , [<Optional>]_output: seq<'t> [] , [<Optional>]_impl: Default3) : seq<'t> [] = Sequence.ForInfiniteSequences (t, Array.isEmpty, List.toSeq, Array.singleton)

#if !FABLE_COMPILER
static member Sequence (t: seq<Async<'t>> , [<Optional>]_output: Async<seq<'t>> , [<Optional>]_impl: Default3) : Async<seq<'t>> = Async.SequentialLazy t
#endif
static member inline Sequence (t: NonEmptySeq<'``Applicative<'T>``>, [<Optional>]_output: '``Applicative<NonEmptySeq<'T>>`` , [<Optional>]_impl: Default4) : '``Applicative<NonEmptySeq<'T>>`` = Sequence.ForInfiniteSequences (t, IsLeftZero.Invoke, NonEmptySeq.ofList)
static member inline Sequence (t: NonEmptySeq<'``Applicative<'T>``>, [<Optional>]_output: '``Applicative<NonEmptySeq<'T>>``, [<Optional>]_impl: Default4) : '``Applicative<NonEmptySeq<'T>>`` = Sequence.ForInfiniteSequences (t, IsLeftZero.Invoke, NonEmptySeq.ofList, fun _ -> Unchecked.defaultof<_>)
static member Sequence (t: NonEmptySeq<option<'t>> , [<Optional>]_output: option<NonEmptySeq<'t>> , [<Optional>]_impl: Default3) : option<NonEmptySeq<'t>> = Option.Sequential t |> Option.map NonEmptySeq.unsafeOfSeq
static member Sequence (t: NonEmptySeq<Result<'t,'e>>, [<Optional>]_output: Result<NonEmptySeq<'t>, 'e>, [<Optional>]_impl: Default3) : Result<NonEmptySeq<'t>, 'e> = Result.Sequential t |> Result.map NonEmptySeq.unsafeOfSeq
static member Sequence (t: NonEmptySeq<Choice<'t,'e>>, [<Optional>]_output: Choice<NonEmptySeq<'t>, 'e>, [<Optional>]_impl: Default3) : Choice<NonEmptySeq<'t>, 'e> = Choice.Sequential t |> Choice.map NonEmptySeq.unsafeOfSeq
static member Sequence (t: NonEmptySeq<list<'t>> , [<Optional>]_output: list<NonEmptySeq<'t>> , [<Optional>]_impl: Default3) : list<NonEmptySeq<'t>> = Sequence.ForInfiniteSequences(t, List.isEmpty , NonEmptySeq.ofList)
static member Sequence (t: NonEmptySeq<'t []> , [<Optional>]_output: NonEmptySeq<'t> [] , [<Optional>]_impl: Default3) : NonEmptySeq<'t> [] = Sequence.ForInfiniteSequences(t, Array.isEmpty, NonEmptySeq.ofList)
static member Sequence (t: NonEmptySeq<list<'t>> , [<Optional>]_output: list<NonEmptySeq<'t>> , [<Optional>]_impl: Default3) : list<NonEmptySeq<'t>> = Sequence.ForInfiniteSequences(t, List.isEmpty , NonEmptySeq.ofList, fun _ -> Unchecked.defaultof<_>)
static member Sequence (t: NonEmptySeq<'t []> , [<Optional>]_output: NonEmptySeq<'t> [] , [<Optional>]_impl: Default3) : NonEmptySeq<'t> [] = Sequence.ForInfiniteSequences(t, Array.isEmpty, NonEmptySeq.ofList, fun _ -> Unchecked.defaultof<_>)
#if !FABLE_COMPILER
static member Sequence (t: NonEmptySeq<Async<'t>> , [<Optional>]_output: Async<NonEmptySeq<'t>> , [<Optional>]_impl: Default3) = Async.SequentialLazy t |> Async.map NonEmptySeq.unsafeOfSeq : Async<NonEmptySeq<'t>>
#endif
Expand All @@ -217,7 +221,7 @@ type Sequence with
#if !FABLE_COMPILER
static member inline Sequence (t: voption<_>, [<Optional>]_output: 'R, [<Optional>]_impl: Sequence) : 'R = match t with ValueSome x -> Map.Invoke ValueSome x | _ -> result ValueNone
#endif
static member inline Sequence (t: list<_> , [<Optional>]_output: 'R, [<Optional>]_impl: Sequence) : 'R = Sequence.ForInfiniteSequences(t, IsLeftZero.Invoke, id)
static member inline Sequence (t: list<_> , [<Optional>]_output: 'R, [<Optional>]_impl: Sequence) : 'R = Sequence.ForInfiniteSequences(t, IsLeftZero.Invoke, id, Return.Invoke)

static member inline Sequence (t: Map<_,_> , [<Optional>]_output: 'R, [<Optional>]_impl: Sequence) : 'R =
let insert_f k x ys = Map.Invoke (Map.add k) x <*> ys
Expand All @@ -233,7 +237,7 @@ type Sequence with
| Choice1Of2 a -> Map.Invoke Choice<'T,'Error>.Choice1Of2 a
| Choice2Of2 e -> Return.Invoke (Choice<'T,'Error>.Choice2Of2 e)

static member inline Sequence (t: _ [] , [<Optional>]_output: 'R , [<Optional>]_impl: Sequence) : 'R = Sequence.ForInfiniteSequences(t, IsLeftZero.Invoke, Array.ofList)
static member inline Sequence (t: _ [] , [<Optional>]_output: 'R , [<Optional>]_impl: Sequence) : 'R = Sequence.ForInfiniteSequences(t, IsLeftZero.Invoke, Array.ofList, Return.Invoke)

static member inline Sequence (t: Id<'``Functor<'T>``> , [<Optional>]_output: '``Functor<Id<'T>>`` , [<Optional>]_impl: Sequence) : '``Functor<Id<'T>>`` = Traverse.Invoke id t

Expand Down
2 changes: 1 addition & 1 deletion tests/FSharpPlus.Tests/Asyncs.fs
Original file line number Diff line number Diff line change
Expand Up @@ -103,7 +103,7 @@ module Async =

let t123 = Async.map3 (fun x y z -> [x; y; z]) t1 t2 t3
let t123' = transpose [t1; t2; t3]
let t123'' = sequence [t1; t2; t3] : Async<int list>
let t123'' = sequence [t1; t2; t3]
CollectionAssert.AreEquivalent ((Async.AsTaskAndWait t123).Exception.InnerExceptions, (Async.AsTaskAndWait t123').Exception.InnerExceptions, "Async.map3 (fun x y z -> [x; y; z]) t1 t2 t3 is the same as transpose [t1; t2; t3]")
CollectionAssert.AreNotEquivalent ((Async.AsTaskAndWait t123).Exception.InnerExceptions, (Async.AsTaskAndWait t123'').Exception.InnerExceptions, "Async.map3 (fun x y z -> [x; y; z]) t1 t2 t3 is not the same as sequence [t1; t2; t3]")

Expand Down
4 changes: 2 additions & 2 deletions tests/FSharpPlus.Tests/Traversals.fs
Original file line number Diff line number Diff line change
Expand Up @@ -115,7 +115,7 @@ module Traversable =
// It hangs if we try to share this value between tests
let expectedEffects =
[
"""f(x) <*> Right 0"""
// map does this -> """f(x) <*> Right 0"""
"""f(x) <*> Right 1"""
"""f(x) <*> Right 2"""
"""f(x) <*> Right 3"""
Expand Down Expand Up @@ -180,7 +180,7 @@ module Traversable =
// It hangs if we try to share this value between tests
let expectedEffects =
[
"""f(x) <*> Right 0"""
// map does this -> """f(x) <*> Right 0"""
"""f(x) <*> Right 1"""
"""f(x) <*> Right 2"""
"""f(x) <*> Right 3"""
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -135,7 +135,7 @@ let traversable = testList "Traversable" [

let expectedEffects =
[
"""f(x) <*> Right 0"""
// map does this -> """f(x) <*> Right 0"""
"""f(x) <*> Right 1"""
"""f(x) <*> Right 2"""
"""f(x) <*> Right 3"""
Expand Down Expand Up @@ -243,7 +243,7 @@ let traversable = testList "Traversable" [
testCase "e" (fun () ->
let expectedEffects =
[
"""f(x) <*> Right 0"""
// map does this -> """f(x) <*> Right 0"""
"""f(x) <*> Right 1"""
"""f(x) <*> Right 2"""
"""f(x) <*> Right 3"""
Expand All @@ -262,7 +262,7 @@ let traversable = testList "Traversable" [
testCase "f" (fun () ->
let expectedEffects =
[
"""f(x) <*> Right 0"""
// map does this -> """f(x) <*> Right 0"""
"""f(x) <*> Right 1"""
"""f(x) <*> Right 2"""
"""f(x) <*> Right 3"""
Expand Down

0 comments on commit 661a2c8

Please sign in to comment.