From df0da0a85ea8fbff773c7a02133d8ddc59900bfb Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Thu, 12 Oct 2023 10:21:03 +0200 Subject: [PATCH 01/27] First draft --- src/FSharpPlus/Builders.fs | 12 ++ src/FSharpPlus/Control/Parallel.fs | 258 ++++++++++++++++++++++++++++ src/FSharpPlus/Extensions/Choice.fs | 13 ++ src/FSharpPlus/Extensions/List.fs | 40 +++++ src/FSharpPlus/Extensions/Result.fs | 13 ++ src/FSharpPlus/FSharpPlus.fsproj | 241 +++++++++++++------------- 6 files changed, 457 insertions(+), 120 deletions(-) create mode 100644 src/FSharpPlus/Control/Parallel.fs diff --git a/src/FSharpPlus/Builders.fs b/src/FSharpPlus/Builders.fs index 0936ae1df..ea391a3bc 100644 --- a/src/FSharpPlus/Builders.fs +++ b/src/FSharpPlus/Builders.fs @@ -210,6 +210,15 @@ module GenericBuilders = member _.Run x : '``Applicative1>>`` = x + /// Generic Parallel Applicative CE builder. + type ParallelBuilder<'``applicative<'t>``> () = + member _.ReturnFrom (expr) = expr : '``applicative<'t>`` + member inline _.Return (x: 'T) = ParReturn.Invoke x : '``Applicative<'T>`` + member inline _.Yield (x: 'T) = ParReturn.Invoke x : '``Applicative<'T>`` + member inline _.BindReturn(x, []f) = map f x : '``Applicative<'U>`` + member inline _.MergeSources (t1: '``Applicative<'T>``, t2: '``Applicative<'U>``) : '``Applicative<'T * 'U>`` = ParLift2.Invoke tuple2 t1 t2 + member inline _.MergeSources3 (t1: '``Applicative<'T>``, t2: '``Applicative<'U>``, t3: '``Applicative<'V>``) : '``Applicative<'T * 'U * 'V>`` = ParLift3.Invoke tuple3 t1 t2 t3 + member _.Run f = f : '``Applicative<'T>`` /// Creates a (lazy) monadic computation expression with side-effects (see http://fsprojects.github.io/FSharpPlus/computation-expressions.html for more information) let monad<'``monad<'t>``> = new MonadFxBuilder<'``monad<'t>``> () @@ -226,4 +235,7 @@ module GenericBuilders = /// Creates an applicative computation expression which compose effects of three Applicatives. let applicative3<'``Applicative1>>``> = ApplicativeBuilder3<'``Applicative1>>``> () + /// Creates a parallel applicative computation expression. + let par<'``Applicative<'T>``> = ParallelBuilder<'``Applicative<'T>``> () + #endif diff --git a/src/FSharpPlus/Control/Parallel.fs b/src/FSharpPlus/Control/Parallel.fs new file mode 100644 index 000000000..99ed736ce --- /dev/null +++ b/src/FSharpPlus/Control/Parallel.fs @@ -0,0 +1,258 @@ +namespace FSharpPlus.Control + +open System +open System.Runtime.InteropServices +open System.Collections.Generic +open System.Threading.Tasks +open Microsoft.FSharp.Quotations + +open FSharpPlus.Internals +open FSharpPlus +open FSharpPlus.Data + + +type ParReturn = + inherit Default1 + static member inline InvokeOnInstance (x: 'T) = (^``ParApplicative<'T>`` : (static member ParReturn : ^T -> ^``ParApplicative<'T>``) x) + +#if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 + + static member inline Invoke (x: 'T) : '``ParApplicative<'T>`` = + let inline call (mthd: ^M, output: ^R) = ((^M or ^R) : (static member ParReturn : _*_ -> _) output, mthd) + call (Unchecked.defaultof, Unchecked.defaultof<'``ParApplicative<'T>``>) x + + + + static member ParReturn (_: seq<'a> , _: Default2) = fun x -> Seq.initInfinite (fun _ -> x) : seq<'a> + static member ParReturn (_: NonEmptySeq<'a>, _: Default2) = fun x -> NonEmptySeq.initInfinite (fun _ -> x) : NonEmptySeq<'a> + // static member ParReturn (_: IEnumerator<'a>, _: Default2) = fun x -> Enumerator.upto None (fun _ -> x) : IEnumerator<'a> + static member inline ParReturn (_: 'R , _: Default1) = fun (x: 'T) -> ParReturn.InvokeOnInstance x : 'R + static member ParReturn (_: Lazy<'a> , _: ParReturn ) = fun x -> Lazy<_>.CreateFromValue x : Lazy<'a> + #if !FABLE_COMPILER + static member ParReturn (_: 'T Task , _: ParReturn ) = fun x -> Task.FromResult x : 'T Task + #endif + #if NETSTANDARD2_1 && !FABLE_COMPILER + static member ParReturn (_: 'T ValueTask , _: ParReturn ) = fun (x: 'T) -> ValueTask<'T> x : 'T ValueTask + #endif + // static member inline ParReturn (_: option<'a> , _: ParReturn ) = fun x -> Some () : option<'a> + // static member inline ParReturn (_ : voption<'a> , _: ParReturn ) = fun x -> ValueSome (Zero.Invoke ()) : voption<'a> + static member ParReturn (_: list<'a> , _: ParReturn ) = fun x -> List.cycle [x] : list<'a> + // static member ParReturn (_: 'a [] , _: ParReturn ) = fun x -> [|x|] : 'a [] + // static member ParReturn (_: 'r -> 'a , _: ParReturn ) = const': 'a -> 'r -> _ + // static member inline ParReturn (_: 'm * 'a , _: ParReturn ) = fun (x: 'a) -> (Zero.Invoke (): 'm), x + // static member inline ParReturn (_: struct ('m * 'a), _: ParReturn ) = fun (x: 'a) -> struct ((Zero.Invoke (): 'm), x) + static member ParReturn (_: 'a Async , _: ParReturn ) = fun (x: 'a) -> async.Return x + static member inline ParReturn (_: Result<'t,'e> , _: ParReturn ) = fun x -> if false then Error (Zero.Invoke (): 'e) else Ok x : Result<'t,'e> + static member inline ParReturn (_: Choice<'t,'e> , _: ParReturn ) = fun x -> if false then Choice2Of2 (Zero.Invoke (): 'e) else Choice1Of2 x : Choice<'t,'e> + #if !FABLE_COMPILER + // static member ParReturn (_: Expr<'a> , _: ParReturn ) = fun x -> Expr.Cast<'a> (Expr.Value (x: 'a)) + #endif + // static member ParReturn (_: ResizeArray<'a>, _: ParReturn ) = fun x -> ResizeArray<'a> (Seq.singleton x) + +#endif + +type ParApply = + inherit Default1 + +#if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 + + static member inline ```` (f: '``Monad<'T->'U>`` , x: '``Monad<'T>`` , []_output: '``Monad<'U>`` , []_mthd:Default2) : '``Monad<'U>`` = Bind.InvokeOnInstance f (fun (x1: 'T->'U) -> Bind.InvokeOnInstance x (fun x2 -> ParReturn.InvokeOnInstance (x1 x2))) + static member inline ```` (f: '``ParApplicative<'T->'U>``, x: '``ParApplicative<'T>``, []_output: '``ParApplicative<'U>``, []_mthd:Default1) : '``ParApplicative<'U>`` = ((^``ParApplicative<'T->'U>`` or ^``ParApplicative<'T>`` or ^``ParApplicative<'U>``) : (static member (<*>) : _*_ -> _) f, x) + + static member ```` (f: Lazy<'T->'U> , x: Lazy<'T> , []_output: Lazy<'U> , []_mthd: ParApply) = Lazy.apply f x : Lazy<'U> + static member ```` (f: seq<_> , x: seq<'T> , []_output: seq<'U> , []_mthd: ParApply) = Seq.map2 (<|) f x : seq<'U> + static member ```` (f: NonEmptySeq<_> , x: NonEmptySeq<'T> , []_output: NonEmptySeq<'U> , []_mthd: ParApply) = NonEmptySeq.map2 (<|) f x : NonEmptySeq<'U> + // static member ```` (f: IEnumerator<_> , x: IEnumerator<'T> , []_output: IEnumerator<'U> , []_mthd: ParApply) = Enumerator.map2 id f x : IEnumerator<'U> + static member ```` (f: list<_> , x: list<'T> , []_output: list<'U> , []_mthd: ParApply) = List.map2Shortest (<|) f x : list<'U> + // static member ```` (f: _ [] , x: 'T [] , []_output: 'U [] , []_mthd: ParApply) = Array.apply f x : 'U [] + // static member ```` (f: 'r -> _ , g: _ -> 'T , []_output: 'r -> 'U , []_mthd: ParApply) = fun x -> let f' = f x in f' (g x) : 'U + // static member inline ```` ((a: 'Monoid, f) , (b: 'Monoid, x: 'T) , []_output: 'Monoid * 'U , []_mthd: ParApply) = (Plus.Invoke a b, f x) : 'Monoid *'U + // static member inline ```` (struct (a: 'Monoid, f), struct (b: 'Monoid, x: 'T), []_output: struct ('Monoid * 'U), []_mthd: ParApply) = struct (Plus.Invoke a b, f x) : struct ('Monoid * 'U) + #if !FABLE_COMPILER + static member ```` (f: Task<_> , x: Task<'T> , []_output: Task<'U> , []_mthd: ParApply) = Task.apply f x : Task<'U> + #endif + #if NETSTANDARD2_1 && !FABLE_COMPILER + static member ```` (f: ValueTask<_> , x: ValueTask<'T> , []_output: ValueTask<'U> , []_mthd: ParApply) = ValueTask.apply f x : ValueTask<'U> + #endif + static member ```` (f: Async<_> , x: Async<'T> , []_output: Async<'U> , []_mthd: ParApply) = Async.apply f x : Async<'U> + // static member ```` (f: option<_> , x: option<'T> , []_output: option<'U> , []_mthd: ParApply) = Option.apply f x : option<'U> + // static member ```` (f: voption<_> , x: voption<'T> , []_output: voption<'U> , []_mthd: ParApply) = ValueOption.apply f x : voption<'U> + static member inline ```` (f: Result<_,'E> , x: Result<'T,'E> , []_output: Result<'b,'E> , []_mthd: ParApply) = Result.apply2With Plus.Invoke (<|) f x : Result<'U, 'E> + static member inline ```` (f: Choice<_,'E> , x: Choice<'T,'E> , []_output: Choice<'b,'E> , []_mthd: ParApply) = Choice.apply2With Plus.Invoke (<|) f x : Choice<'U, 'E> + // static member inline ```` (KeyValue(a: 'Key, f), KeyValue(b: 'Key, x: 'T), []_output: KeyValuePair<'Key,'U>, []_mthd: ParApply) : KeyValuePair<'Key,'U> = KeyValuePair (Plus.Invoke a b, f x) + + // static member ```` (f: Map<'Key,_> , x: Map<'Key,'T> , []_output: Map<'Key,'U> , []_mthd: ParApply) : Map<'Key,'U> = Map (seq { + // for KeyValue(k, vf) in f do + // match Map.tryFind k x with + // | Some vx -> yield k, vf vx + // | _ -> () }) + + // static member ```` (f: Dictionary<'Key,_>, x: Dictionary<'Key,'T> , []_output: Dictionary<'Key,'U> , []_mthd: ParApply) : Dictionary<'Key,'U> = + // let dct = Dictionary () + // for KeyValue(k, vf) in f do + // match x.TryGetValue k with + // | true, vx -> dct.Add (k, vf vx) + // | _ -> () + // dct + + // static member ```` (f: IDictionary<'Key,_>, x: IDictionary<'Key,'T> , []_output: IDictionary<'Key,'U> , []_mthd: ParApply) : IDictionary<'Key,'U> = + // let dct = Dictionary () + // for KeyValue(k, vf) in f do + // match x.TryGetValue k with + // | true, vx -> dct.Add (k, vf vx) + // | _ -> () + // dct :> IDictionary<'Key,'U> + + // static member ```` (f: IReadOnlyDictionary<'Key,_>, x: IReadOnlyDictionary<'Key,'T> , []_output: IReadOnlyDictionary<'Key,'U> , []_mthd: ParApply) : IReadOnlyDictionary<'Key,'U> = + // let dct = Dictionary () + // for KeyValue(k, vf) in f do + // match x.TryGetValue k with + // | true, vx -> dct.Add (k, vf vx) + // | _ -> () + // dct :> IReadOnlyDictionary<'Key,'U> + + // #if !FABLE_COMPILER + // static member ```` (f: Expr<'T->'U>, x: Expr<'T>, []_output: Expr<'U>, []_mthd: ParApply) = Expr.Cast<'U> (Expr.Application (f, x)) + // #endif + // static member ```` (f: ('T->'U) ResizeArray, x: 'T ResizeArray, []_output: 'U ResizeArray, []_mthd: ParApply) = ResizeArray.apply f x : 'U ResizeArray + + static member inline Invoke (f: '``ParApplicative<'T -> 'U>``) (x: '``ParApplicative<'T>``) : '``ParApplicative<'U>`` = + let inline call (mthd : ^M, input1: ^I1, input2: ^I2, output: ^R) = + ((^M or ^I1 or ^I2 or ^R) : (static member ```` : _*_*_*_ -> _) input1, input2, output, mthd) + call(Unchecked.defaultof, f, x, Unchecked.defaultof<'``ParApplicative<'U>``>) + + +#endif + + static member inline InvokeOnInstance (f: '``ParApplicative<'T->'U>``) (x: '``ParApplicative<'T>``) : '``ParApplicative<'U>`` = + ((^``ParApplicative<'T->'U>`` or ^``ParApplicative<'T>`` or ^``ParApplicative<'U>``) : (static member (<*>) : _*_ -> _) (f, x)) + +#if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 + +type ParLift2 = + inherit Default1 + + static member ParLift2 (f, (x: Lazy<_> , y: Lazy<_> ), _mthd: ParLift2) = Lazy.map2 f x y + static member ParLift2 (f, (x: seq<_> , y: seq<_> ), _mthd: ParLift2) = Seq.map2 f x y + static member ParLift2 (f, (x: NonEmptySeq<_> , y: NonEmptySeq<_> ), _mthd: ParLift2) = NonEmptySeq.map2 f x y + // static member ParLift2 (f, (x: IEnumerator<_> , y: IEnumerator<_> ), _mthd: ParLift2) = Enumerator.map2 f x y + static member ParLift2 (f, (x , y ), _mthd: ParLift2) = List.map2Shortest f x y + // static member ParLift2 (f, (x , y ), _mthd: ParLift2) = Array.lift2 f x y + // static member ParLift2 (f, (x: 'R -> 'T , y: 'R -> 'U ), _mthd: ParLift2) = fun a -> f (x a) (y a) + // static member inline ParLift2 (f, ((a: 'Monoid, x: 'T) , (b: 'Monoid, y: 'U) ), _mthd: ParLift2) = Plus.Invoke a b, f x y + // static member inline ParLift2 (f, (struct (a: 'Monoid, x: 'T), struct (b: 'Monoid, y: 'U)), _mthd: ParLift2) = struct (Plus.Invoke a b, f x y) + #if !FABLE_COMPILER + static member ParLift2 (f, (x: Task<'T> , y: Task<'U> ), _mthd: ParLift2) = Task.map2 f x y + #endif + #if NETSTANDARD2_1 && !FABLE_COMPILER + static member ParLift2 (f, (x: ValueTask<'T> , y: ValueTask<'U> ), _mthd: ParLift2) = ValueTask.map2 f x y + #endif + static member ParLift2 (f, (x , y ), _mthd: ParLift2) = Async.map2 f x y + // static member ParLift2 (f, (x , y ), _mthd: ParLift2) = Option.map2 f x y + + // #if !FABLE_COMPILER + // static member ParLift2 (f, (x , y ), _mthd: ParLift2) = ValueOption.map2 f x y + // #endif + static member inline ParLift2 (f, (x: Result<'T,'Error> , y: Result<'U,'Error> ), _mthd: ParLift2) = Result.apply2With Plus.Invoke f x y + static member inline ParLift2 (f, (x: Choice<'T,'Error> , y: Choice<'U,'Error> ), _mthd: ParLift2) = Choice.map2 f x y + static member ParLift2 (f, (x: Map<'Key,'T> , y : Map<'Key,'U> ), _mthd: ParLift2) = Map.mapValues2 f x y + static member ParLift2 (f, (x: Dictionary<'Key,'T>, y: Dictionary<'Key,'U>), _mthd: ParLift2) = Dictionary.map2 f x y + #if !FABLE_COMPILER + static member ParLift2 (f, (x: Expr<'T> , y: Expr<'U> ), _mthd: ParLift2) = <@ f %x %y @> + #endif + static member ParLift2 (f, (x: ResizeArray<'T> , y: ResizeArray<'U> ), _mthd: ParLift2) = ResizeArray.lift2 f x y + + static member inline Invoke (f: 'T -> 'U -> 'V) (x: '``ParApplicative<'T>``) (y: '``ParApplicative<'U>``) : '``ParApplicative<'V>`` = + let inline call (mthd : ^M, input1: ^I1, input2: ^I2, _output: ^R) = + ((^M or ^I1 or ^I2 or ^R) : (static member ParLift2 : _*(_*_)*_ -> _) f, (input1, input2), mthd) + call (Unchecked.defaultof, x, y, Unchecked.defaultof<'``ParApplicative<'V>``>) + + static member inline InvokeOnInstance (f: 'T -> 'U -> 'V) (x: '``ParApplicative<'T>``) (y: '``ParApplicative<'U>``) = + ((^``ParApplicative<'T>`` or ^``ParApplicative<'U>``) : (static member ParLift2 : _*_*_ -> _) f, x, y) + +type ParLift2 with + static member inline ParLift2 (f, (x, y), _mthd: Default2) = (((ParReturn.InvokeOnInstance f, x) ||> ParApply.InvokeOnInstance), y) ||> ParApply.InvokeOnInstance + + static member inline ParLift2 (_, (_:'t when 't: null and 't: struct, _: ^u when ^u : null and ^u: struct), _mthd: Default1) = id + static member inline ParLift2 (f: 'T -> 'U -> 'V, (x: '``ParApplicative<'T>``, y: '``ParApplicative<'U>``) , _mthd: Default1) = ((^``ParApplicative<'T>`` or ^``ParApplicative<'U>`` ) : (static member ParLift2 : _*_*_ -> _) f, x, y) + +type ParLift3 = + inherit Default1 + + static member ParLift3 (f, (x: Lazy<_> , y: Lazy<_> , z: Lazy<_> ), _mthd: ParLift3) = Lazy.map3 f x y z + static member ParLift3 (f, (x: seq<_> , y: seq<_> , z: seq<_> ), _mthd: ParLift3) = Seq.map3 f x y z + static member ParLift3 (f, (x: NonEmptySeq<_> , y: NonEmptySeq<_> , z: NonEmptySeq<_> ), _mthd: ParLift3) = NonEmptySeq.map3 f x y z + // static member ParLift3 (f, (x: IEnumerator<_> , y: IEnumerator<_> , z: IEnumerator<_> ), _mthd: ParLift3) = Enumerator.map3 f x y z + static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = List.map3Shortest f x y z + // static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = Array.lift3 f x y z + // member ParLift3 (f, (x: 'R -> 'T , y: 'R -> 'U , z: 'R -> 'V ), _mthd: ParLift3) = fun a -> f (x a) (y a) (z a) + // member inline ParLift3 (f, ((a: 'Monoid, x: 'T) , (b: 'Monoid, y: 'U) , (c: 'Monoid, z: 'U) ), _mthd: ParLift3) = Plus.Invoke (Plus.Invoke a b) c, f x y z + // member inline ParLift3 (f, (struct (a: 'Monoid, x: 'T), struct (b: 'Monoid, y: 'U), struct (c: 'Monoid, z: 'U)), _mthd: ParLift3) = struct (Plus.Invoke (Plus.Invoke a b) c, f x y z) + #if !FABLE_COMPILER + static member ParLift3 (f, (x: Task<'T> , y: Task<'U> , z: Task<'V> ), _mthd: ParLift3) = Task.map3 f x y z + #endif + #if NETSTANDARD2_1 && !FABLE_COMPILER + static member ParLift3 (f, (x: ValueTask<'T> , y: ValueTask<'U> , z: ValueTask<'V> ), _mthd: ParLift3) = ValueTask.map3 f x y z + #endif + static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = Async.map3 f x y z + // static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = Option.map3 f x y z + + // #if !FABLE_COMPILER + // static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = ValueOption.map3 f x y z + // #endif + static member inline ParLift3 (f, (x: Result<'T,'Error> , y: Result<'U,'Error> , z: Result<'V, 'Error> ), _mthd: ParLift3) = Result.apply3With Plus.Invoke f x y z + static member inline ParLift3 (f, (x: Choice<'T,'Error> , y: Choice<'U,'Error> , z: Choice<'V, 'Error> ), _mthd: ParLift3) = Choice.apply3With Plus.Invoke f x y z + // static member ParLift3 (f, (x: Map<'Key,'T> , y: Map<'Key,'U> , z: Map<'Key, 'V> ), _mthd: ParLift3) = Map.mapValues3 f x y z + // static member ParLift3 (f, (x: Dictionary<'Key,'T>, y: Dictionary<'Key,'U>, z: Dictionary<'Key, 'V>), _mthd: ParLift3) = Dictionary.map3 f x y z + // #if !FABLE_COMPILER + // static member ParLift3 (f, (x: Expr<'T> , y: Expr<'U> , z: Expr<'V> ), _mthd: ParLift3) = <@ f %x %y %z @> + // #endif + // static member ParLift3 (f, (x: ResizeArray<'T> , y: ResizeArray<'U> , z: ResizeArray<'V> ), _mthd: ParLift3) = ResizeArray.lift3 f x y z + + static member inline Invoke (f: 'T -> 'U -> 'V -> 'W) (x: '``ParApplicative<'T>``) (y: '``ParApplicative<'U>``) (z: '``ParApplicative<'V>``): '``ParApplicative<'W>`` = + let inline call (mthd : ^M, input1: ^I1, input2: ^I2, input3: ^I3, _output: ^R) = + ((^M or ^I1 or ^I2 or ^I3 or ^R) : (static member ParLift3 : _*(_*_*_)*_ -> _) f, (input1, input2, input3), mthd) + call (Unchecked.defaultof, x, y, z, Unchecked.defaultof<'``ParApplicative<'W>``>) + + static member inline InvokeOnInstance (f: 'T -> 'U -> 'V -> 'W) (x: '``ParApplicative<'T>``) (y: '``ParApplicative<'U>``) (z: '``ParApplicative<'V>``)= + ((^``ParApplicative<'T>`` or ^``ParApplicative<'U>`` or ^``ParApplicative<'V>``) : (static member ParLift3 : _*_*_*_ -> _) f, x, y, z) + +type ParLift3 with + static member inline ParLift3 (f, (x, y, z), _mthd: Default3) = ((((ParReturn.InvokeOnInstance f, x) ||> ParApply.InvokeOnInstance), y) ||> ParApply.InvokeOnInstance, z) ||> ParApply.InvokeOnInstance + static member inline ParLift3 (_, (_:'t when 't: null and 't: struct, _: ^u when ^u : null and ^u: struct, _: ^v when ^v : null and ^v: struct), _mthd: Default1) = id + static member inline ParLift3 (f: 'T -> 'U -> 'V -> 'W, (x: '``ParApplicative<'T>``, y: '``ParApplicative<'U>``, z: '``ParApplicative<'V>``) , _mthd: Default1) = ((^``ParApplicative<'T>`` or ^``ParApplicative<'U>`` or ^``ParApplicative<'V>`` ) : (static member ParLift3 : _*_*_*_ -> _) f, x, y, z) + +type IsParLeftZero = + inherit Default1 + + static member IsParLeftZero (_: ref> , _mthd: IsParLeftZero) = false + static member IsParLeftZero (_: ref>, _mthd: IsParLeftZero) = false + static member IsParLeftZero (_: ref> , _mthd: IsParLeftZero) = false + // static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = Array.isEmpty t.Value + // static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = Option.isNone t.Value + // #if !FABLE_COMPILER + // static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = ValueOption.isNone t.Value + // #endif + static member IsParLeftZero (_: ref> , _mthd: IsParLeftZero) = false + static member IsParLeftZero (_: ref> , _mthd: IsParLeftZero) = false + + static member inline Invoke (x: '``ParApplicative<'T>``) : bool = + let inline call (mthd : ^M, input: ^I) = + ((^M or ^I) : (static member IsParLeftZero : _*_ -> _) ref input, mthd) + call(Unchecked.defaultof, x) + + static member inline InvokeOnInstance (x: '``ParApplicative<'T>``) : bool = + ((^``ParApplicative<'T>``) : (static member IsParLeftZero : _ -> _) x) + +type IsParLeftZero with + + static member inline IsParLeftZero (_: ref<'T> when 'T : struct , _mthd: Default4) = false + static member inline IsParLeftZero (_: ref<'T> when 'T : not struct, _mthd: Default3) = false + + // empty <*> f = empty ==> empty is left zero for <*> + static member inline IsParLeftZero (t: ref<'``Alternative<'T>``> , _mthd: Default2) = (t.Value = Empty.InvokeOnInstance ()) + + static member inline IsParLeftZero (t: ref<'``ParApplicative<'T>``> , _mthd: Default1) = (^``ParApplicative<'T>`` : (static member IsParLeftZero : _ -> _) t.Value) + static member inline IsParLeftZero (_: ref< ^t> when ^t: null and ^t: struct, _: Default1) = () + +#endif \ No newline at end of file diff --git a/src/FSharpPlus/Extensions/Choice.fs b/src/FSharpPlus/Extensions/Choice.fs index 630a87843..1230ed116 100644 --- a/src/FSharpPlus/Extensions/Choice.fs +++ b/src/FSharpPlus/Extensions/Choice.fs @@ -82,3 +82,16 @@ module Choice = try Choice1Of2 (f x) with e -> Choice2Of2 e + + let apply2With combiner f (x: Choice<'T, 'Error>) (y: Choice<'U, 'Error>) : Choice<'V, 'Error> = + match x, y with + | Choice1Of2 a, Choice1Of2 b -> Choice1Of2 (f a b) + | Choice2Of2 e, Choice1Of2 _ | Choice1Of2 _, Choice2Of2 e -> Choice2Of2 e + | Choice2Of2 e1, Choice2Of2 e2 -> Choice2Of2 (combiner e1 e2) + + let apply3With combiner f (x: Choice<'T, 'Error>) (y: Choice<'U, 'Error>) (z: Choice<'V, 'Error>) : Choice<'W, 'Error> = + match x, y, z with + | Choice1Of2 a, Choice1Of2 b, Choice1Of2 c -> Choice1Of2 (f a b c) + | Choice2Of2 e, Choice1Of2 _, Choice1Of2 _ | Choice1Of2 _, Choice2Of2 e, Choice1Of2 _ | Choice1Of2 _, Choice1Of2 _, Choice2Of2 e -> Choice2Of2 e + | Choice1Of2 _, Choice2Of2 e1, Choice2Of2 e2 | Choice2Of2 e1, Choice1Of2 _, Choice2Of2 e2 | Choice2Of2 e1, Choice2Of2 e2, Choice1Of2 _ -> Choice2Of2 (combiner e1 e2) + | Choice2Of2 e1, Choice2Of2 e2, Choice2Of2 e3 -> Choice2Of2 (combiner (combiner e1 e2) e3) \ No newline at end of file diff --git a/src/FSharpPlus/Extensions/List.fs b/src/FSharpPlus/Extensions/List.fs index b11cf15d6..cb06fb76d 100644 --- a/src/FSharpPlus/Extensions/List.fs +++ b/src/FSharpPlus/Extensions/List.fs @@ -318,6 +318,22 @@ module List = loop (ls, rs) loop (list1, list2) #endif + + let map3Shortest mapping (list1: list<'T1>) (list2: list<'T2>) (list3: list<'T3>) : list<'U> = + #if FABLE_COMPILER + let rec loop acc = function + | (l1::l1s, l2::l2s, l3::l3s) -> loop ((mapping l1 l2 l3)::acc) (l1s, l2s, l3s) + | (_, _, _) -> acc + loop [] (list1, list2, list3) |> List.rev + #else + let mutable coll = new ListCollector<'U> () + let rec loop = function + | ([], _, _) | (_, [], _)| (_, _, []) -> coll.Close () + | (l1::l1s, l2::l2s, l3::l3s) -> + coll.Add (mapping l1 l2 l3) + loop (l1s, l2s, l3s) + loop (list1, list2, list3) + #endif /// /// Zip safely two lists. If one list is shorter, excess elements are discarded from the right end of the longer list. @@ -378,3 +394,27 @@ module List = if List.length lst > i && i >= 0 then lst.[0..i-1] @ x::lst.[i+1..] else lst + + #if !FABLE_COMPILER + open System.Reflection + + /// Creates an infinite list which cycles the element of the source. + let cycle lst = + let last = ref lst + let rec copy = function + | [] -> failwith "empty list" + | [z] -> + let v = [z] + last.Value <- v + v + | x::xs -> x::copy xs + let cycled = copy lst + let strs = last.Value.GetType().GetFields(BindingFlags.NonPublic ||| BindingFlags.Instance) |> Array.map (fun field -> field.Name) + let tailField = last.Value.GetType().GetField(Array.find(fun (s:string) -> s.ToLower().Contains("tail")) strs, BindingFlags.NonPublic ||| BindingFlags.Instance) + tailField.SetValue(last.Value, cycled) + cycled + #else + let cycle lst = lst + // TODO does it get garbage collected ? Is there a way to implement it in fable ? + #endif + diff --git a/src/FSharpPlus/Extensions/Result.fs b/src/FSharpPlus/Extensions/Result.fs index 00efe40d4..832535aac 100644 --- a/src/FSharpPlus/Extensions/Result.fs +++ b/src/FSharpPlus/Extensions/Result.fs @@ -159,3 +159,16 @@ module Result = List.iter (function Ok e -> coll1.Add e | Error e -> coll2.Add e) source coll1.Close (), coll2.Close () #endif + + let apply2With combiner f (x: Result<'T,'Error>) (y: Result<'U,'Error>) : Result<'V,'Error> = + match x, y with + | Ok a, Ok b -> Ok (f a b) + | Error e, Ok _ | Ok _, Error e -> Error e + | Error e1, Error e2 -> Error (combiner e1 e2) + + let apply3With combiner f (x: Result<'T,'Error>) (y: Result<'U,'Error>) (z: Result<'V,'Error>) : Result<'W,'Error> = + match x, y, z with + | Ok a, Ok b, Ok c -> Ok (f a b c) + | Error e, Ok _, Ok _ | Ok _, Error e, Ok _ | Ok _, Ok _, Error e -> Error e + | Ok _, Error e1, Error e2 | Error e1, Ok _, Error e2 | Error e1, Error e2, Ok _ -> Error (combiner e1 e2) + | Error e1, Error e2, Error e3 -> Error (combiner (combiner e1 e2) e3) diff --git a/src/FSharpPlus/FSharpPlus.fsproj b/src/FSharpPlus/FSharpPlus.fsproj index c113e81ba..e84694f32 100644 --- a/src/FSharpPlus/FSharpPlus.fsproj +++ b/src/FSharpPlus/FSharpPlus.fsproj @@ -1,125 +1,126 @@ - - $(FSC_ToolPathCompilerBuild) - $(FSC_ExePathCompilerBuild) - - - FSharpPlus - FSharpPlus - $(VersionPrefix).0 - $(VersionPrefix).0 - 1368368e-d2f4-4fef-bb2f-492e05156e0f - true - --warnon:1182 $(OtherFlags) - false - false - false - false - false - false - true - Debug;Release;Fable;Fable3;Test - AnyCPU - 6.0 - $(DefineConstants);TEST_TRACE - $(DefineConstants);FABLE_COMPILER - $(DefineConstants);FABLE_COMPILER;FABLE_COMPILER_3 - $(DefineConstants);FABLE_COMPILER;FABLE_COMPILER_4 - netstandard2.0;netstandard2.1 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + $(FSC_ToolPathCompilerBuild) + $(FSC_ExePathCompilerBuild) + + + FSharpPlus + FSharpPlus + $(VersionPrefix).0 + $(VersionPrefix).0 + 1368368e-d2f4-4fef-bb2f-492e05156e0f + true + --warnon:1182 $(OtherFlags) + false + false + false + false + false + false + true + Debug;Release;Fable;Fable3;Test + AnyCPU + 6.0 + $(DefineConstants);TEST_TRACE + $(DefineConstants);FABLE_COMPILER + $(DefineConstants);FABLE_COMPILER;FABLE_COMPILER_3 + $(DefineConstants);FABLE_COMPILER;FABLE_COMPILER_4 + netstandard2.0;netstandard2.1 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - + + + + + + + + - - - + + + From bf5795507dea787469a6eea2f8d58957d50ad41a Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Thu, 12 Oct 2023 12:53:40 +0200 Subject: [PATCH 02/27] Reintroduce commented out overloads --- src/FSharpPlus/Control/Parallel.fs | 162 ++++++++++++++--------------- 1 file changed, 81 insertions(+), 81 deletions(-) diff --git a/src/FSharpPlus/Control/Parallel.fs b/src/FSharpPlus/Control/Parallel.fs index 99ed736ce..b4b849661 100644 --- a/src/FSharpPlus/Control/Parallel.fs +++ b/src/FSharpPlus/Control/Parallel.fs @@ -25,7 +25,7 @@ type ParReturn = static member ParReturn (_: seq<'a> , _: Default2) = fun x -> Seq.initInfinite (fun _ -> x) : seq<'a> static member ParReturn (_: NonEmptySeq<'a>, _: Default2) = fun x -> NonEmptySeq.initInfinite (fun _ -> x) : NonEmptySeq<'a> - // static member ParReturn (_: IEnumerator<'a>, _: Default2) = fun x -> Enumerator.upto None (fun _ -> x) : IEnumerator<'a> + static member ParReturn (_: IEnumerator<'a>, _: Default2) = fun x -> Enumerator.upto None (fun _ -> x) : IEnumerator<'a> static member inline ParReturn (_: 'R , _: Default1) = fun (x: 'T) -> ParReturn.InvokeOnInstance x : 'R static member ParReturn (_: Lazy<'a> , _: ParReturn ) = fun x -> Lazy<_>.CreateFromValue x : Lazy<'a> #if !FABLE_COMPILER @@ -34,20 +34,20 @@ type ParReturn = #if NETSTANDARD2_1 && !FABLE_COMPILER static member ParReturn (_: 'T ValueTask , _: ParReturn ) = fun (x: 'T) -> ValueTask<'T> x : 'T ValueTask #endif - // static member inline ParReturn (_: option<'a> , _: ParReturn ) = fun x -> Some () : option<'a> - // static member inline ParReturn (_ : voption<'a> , _: ParReturn ) = fun x -> ValueSome (Zero.Invoke ()) : voption<'a> + static member inline ParReturn (_: option<'a> , _: ParReturn ) = fun x -> Some () : option<'a> + static member inline ParReturn (_ : voption<'a> , _: ParReturn ) = fun x -> ValueSome (Zero.Invoke ()) : voption<'a> static member ParReturn (_: list<'a> , _: ParReturn ) = fun x -> List.cycle [x] : list<'a> - // static member ParReturn (_: 'a [] , _: ParReturn ) = fun x -> [|x|] : 'a [] - // static member ParReturn (_: 'r -> 'a , _: ParReturn ) = const': 'a -> 'r -> _ - // static member inline ParReturn (_: 'm * 'a , _: ParReturn ) = fun (x: 'a) -> (Zero.Invoke (): 'm), x - // static member inline ParReturn (_: struct ('m * 'a), _: ParReturn ) = fun (x: 'a) -> struct ((Zero.Invoke (): 'm), x) + static member ParReturn (_: 'a [] , _: ParReturn ) = fun x -> [|x|] : 'a [] + static member ParReturn (_: 'r -> 'a , _: ParReturn ) = Prelude.const': 'a -> 'r -> _ + static member inline ParReturn (_: 'm * 'a , _: ParReturn ) = fun (x: 'a) -> (Zero.Invoke (): 'm), x + static member inline ParReturn (_: struct ('m * 'a), _: ParReturn ) = fun (x: 'a) -> struct ((Zero.Invoke (): 'm), x) static member ParReturn (_: 'a Async , _: ParReturn ) = fun (x: 'a) -> async.Return x static member inline ParReturn (_: Result<'t,'e> , _: ParReturn ) = fun x -> if false then Error (Zero.Invoke (): 'e) else Ok x : Result<'t,'e> static member inline ParReturn (_: Choice<'t,'e> , _: ParReturn ) = fun x -> if false then Choice2Of2 (Zero.Invoke (): 'e) else Choice1Of2 x : Choice<'t,'e> #if !FABLE_COMPILER - // static member ParReturn (_: Expr<'a> , _: ParReturn ) = fun x -> Expr.Cast<'a> (Expr.Value (x: 'a)) + static member ParReturn (_: Expr<'a> , _: ParReturn ) = fun x -> Expr.Cast<'a> (Expr.Value (x: 'a)) #endif - // static member ParReturn (_: ResizeArray<'a>, _: ParReturn ) = fun x -> ResizeArray<'a> (Seq.singleton x) + static member ParReturn (_: ResizeArray<'a>, _: ParReturn ) = fun x -> ResizeArray<'a> (Seq.singleton x) #endif @@ -62,12 +62,12 @@ type ParApply = static member ```` (f: Lazy<'T->'U> , x: Lazy<'T> , []_output: Lazy<'U> , []_mthd: ParApply) = Lazy.apply f x : Lazy<'U> static member ```` (f: seq<_> , x: seq<'T> , []_output: seq<'U> , []_mthd: ParApply) = Seq.map2 (<|) f x : seq<'U> static member ```` (f: NonEmptySeq<_> , x: NonEmptySeq<'T> , []_output: NonEmptySeq<'U> , []_mthd: ParApply) = NonEmptySeq.map2 (<|) f x : NonEmptySeq<'U> - // static member ```` (f: IEnumerator<_> , x: IEnumerator<'T> , []_output: IEnumerator<'U> , []_mthd: ParApply) = Enumerator.map2 id f x : IEnumerator<'U> + static member ```` (f: IEnumerator<_> , x: IEnumerator<'T> , []_output: IEnumerator<'U> , []_mthd: ParApply) = Enumerator.map2 id f x : IEnumerator<'U> static member ```` (f: list<_> , x: list<'T> , []_output: list<'U> , []_mthd: ParApply) = List.map2Shortest (<|) f x : list<'U> - // static member ```` (f: _ [] , x: 'T [] , []_output: 'U [] , []_mthd: ParApply) = Array.apply f x : 'U [] - // static member ```` (f: 'r -> _ , g: _ -> 'T , []_output: 'r -> 'U , []_mthd: ParApply) = fun x -> let f' = f x in f' (g x) : 'U - // static member inline ```` ((a: 'Monoid, f) , (b: 'Monoid, x: 'T) , []_output: 'Monoid * 'U , []_mthd: ParApply) = (Plus.Invoke a b, f x) : 'Monoid *'U - // static member inline ```` (struct (a: 'Monoid, f), struct (b: 'Monoid, x: 'T), []_output: struct ('Monoid * 'U), []_mthd: ParApply) = struct (Plus.Invoke a b, f x) : struct ('Monoid * 'U) + static member ```` (f: _ [] , x: 'T [] , []_output: 'U [] , []_mthd: ParApply) = Array.apply f x : 'U [] + static member ```` (f: 'r -> _ , g: _ -> 'T , []_output: 'r -> 'U , []_mthd: ParApply) = fun x -> let f' = f x in f' (g x) : 'U + static member inline ```` ((a: 'Monoid, f) , (b: 'Monoid, x: 'T) , []_output: 'Monoid * 'U , []_mthd: ParApply) = (Plus.Invoke a b, f x) : 'Monoid *'U + static member inline ```` (struct (a: 'Monoid, f), struct (b: 'Monoid, x: 'T), []_output: struct ('Monoid * 'U), []_mthd: ParApply) = struct (Plus.Invoke a b, f x) : struct ('Monoid * 'U) #if !FABLE_COMPILER static member ```` (f: Task<_> , x: Task<'T> , []_output: Task<'U> , []_mthd: ParApply) = Task.apply f x : Task<'U> #endif @@ -75,46 +75,46 @@ type ParApply = static member ```` (f: ValueTask<_> , x: ValueTask<'T> , []_output: ValueTask<'U> , []_mthd: ParApply) = ValueTask.apply f x : ValueTask<'U> #endif static member ```` (f: Async<_> , x: Async<'T> , []_output: Async<'U> , []_mthd: ParApply) = Async.apply f x : Async<'U> - // static member ```` (f: option<_> , x: option<'T> , []_output: option<'U> , []_mthd: ParApply) = Option.apply f x : option<'U> - // static member ```` (f: voption<_> , x: voption<'T> , []_output: voption<'U> , []_mthd: ParApply) = ValueOption.apply f x : voption<'U> + static member ```` (f: option<_> , x: option<'T> , []_output: option<'U> , []_mthd: ParApply) = Option.apply f x : option<'U> + static member ```` (f: voption<_> , x: voption<'T> , []_output: voption<'U> , []_mthd: ParApply) = ValueOption.apply f x : voption<'U> static member inline ```` (f: Result<_,'E> , x: Result<'T,'E> , []_output: Result<'b,'E> , []_mthd: ParApply) = Result.apply2With Plus.Invoke (<|) f x : Result<'U, 'E> static member inline ```` (f: Choice<_,'E> , x: Choice<'T,'E> , []_output: Choice<'b,'E> , []_mthd: ParApply) = Choice.apply2With Plus.Invoke (<|) f x : Choice<'U, 'E> - // static member inline ```` (KeyValue(a: 'Key, f), KeyValue(b: 'Key, x: 'T), []_output: KeyValuePair<'Key,'U>, []_mthd: ParApply) : KeyValuePair<'Key,'U> = KeyValuePair (Plus.Invoke a b, f x) - - // static member ```` (f: Map<'Key,_> , x: Map<'Key,'T> , []_output: Map<'Key,'U> , []_mthd: ParApply) : Map<'Key,'U> = Map (seq { - // for KeyValue(k, vf) in f do - // match Map.tryFind k x with - // | Some vx -> yield k, vf vx - // | _ -> () }) - - // static member ```` (f: Dictionary<'Key,_>, x: Dictionary<'Key,'T> , []_output: Dictionary<'Key,'U> , []_mthd: ParApply) : Dictionary<'Key,'U> = - // let dct = Dictionary () - // for KeyValue(k, vf) in f do - // match x.TryGetValue k with - // | true, vx -> dct.Add (k, vf vx) - // | _ -> () - // dct - - // static member ```` (f: IDictionary<'Key,_>, x: IDictionary<'Key,'T> , []_output: IDictionary<'Key,'U> , []_mthd: ParApply) : IDictionary<'Key,'U> = - // let dct = Dictionary () - // for KeyValue(k, vf) in f do - // match x.TryGetValue k with - // | true, vx -> dct.Add (k, vf vx) - // | _ -> () - // dct :> IDictionary<'Key,'U> - - // static member ```` (f: IReadOnlyDictionary<'Key,_>, x: IReadOnlyDictionary<'Key,'T> , []_output: IReadOnlyDictionary<'Key,'U> , []_mthd: ParApply) : IReadOnlyDictionary<'Key,'U> = - // let dct = Dictionary () - // for KeyValue(k, vf) in f do - // match x.TryGetValue k with - // | true, vx -> dct.Add (k, vf vx) - // | _ -> () - // dct :> IReadOnlyDictionary<'Key,'U> - - // #if !FABLE_COMPILER - // static member ```` (f: Expr<'T->'U>, x: Expr<'T>, []_output: Expr<'U>, []_mthd: ParApply) = Expr.Cast<'U> (Expr.Application (f, x)) - // #endif - // static member ```` (f: ('T->'U) ResizeArray, x: 'T ResizeArray, []_output: 'U ResizeArray, []_mthd: ParApply) = ResizeArray.apply f x : 'U ResizeArray + static member inline ```` (KeyValue(a: 'Key, f), KeyValue(b: 'Key, x: 'T), []_output: KeyValuePair<'Key,'U>, []_mthd: ParApply) : KeyValuePair<'Key,'U> = KeyValuePair (Plus.Invoke a b, f x) + + static member ```` (f: Map<'Key,_> , x: Map<'Key,'T> , []_output: Map<'Key,'U> , []_mthd: ParApply) : Map<'Key,'U> = Map (seq { + for KeyValue(k, vf) in f do + match Map.tryFind k x with + | Some vx -> yield k, vf vx + | _ -> () }) + + static member ```` (f: Dictionary<'Key,_>, x: Dictionary<'Key,'T> , []_output: Dictionary<'Key,'U> , []_mthd: ParApply) : Dictionary<'Key,'U> = + let dct = Dictionary () + for KeyValue(k, vf) in f do + match x.TryGetValue k with + | true, vx -> dct.Add (k, vf vx) + | _ -> () + dct + + static member ```` (f: IDictionary<'Key,_>, x: IDictionary<'Key,'T> , []_output: IDictionary<'Key,'U> , []_mthd: ParApply) : IDictionary<'Key,'U> = + let dct = Dictionary () + for KeyValue(k, vf) in f do + match x.TryGetValue k with + | true, vx -> dct.Add (k, vf vx) + | _ -> () + dct :> IDictionary<'Key,'U> + + static member ```` (f: IReadOnlyDictionary<'Key,_>, x: IReadOnlyDictionary<'Key,'T> , []_output: IReadOnlyDictionary<'Key,'U> , []_mthd: ParApply) : IReadOnlyDictionary<'Key,'U> = + let dct = Dictionary () + for KeyValue(k, vf) in f do + match x.TryGetValue k with + | true, vx -> dct.Add (k, vf vx) + | _ -> () + dct :> IReadOnlyDictionary<'Key,'U> + + #if !FABLE_COMPILER + static member ```` (f: Expr<'T->'U>, x: Expr<'T>, []_output: Expr<'U>, []_mthd: ParApply) = Expr.Cast<'U> (Expr.Application (f, x)) + #endif + static member ```` (f: ('T->'U) ResizeArray, x: 'T ResizeArray, []_output: 'U ResizeArray, []_mthd: ParApply) = ResizeArray.apply f x : 'U ResizeArray static member inline Invoke (f: '``ParApplicative<'T -> 'U>``) (x: '``ParApplicative<'T>``) : '``ParApplicative<'U>`` = let inline call (mthd : ^M, input1: ^I1, input2: ^I2, output: ^R) = @@ -135,12 +135,12 @@ type ParLift2 = static member ParLift2 (f, (x: Lazy<_> , y: Lazy<_> ), _mthd: ParLift2) = Lazy.map2 f x y static member ParLift2 (f, (x: seq<_> , y: seq<_> ), _mthd: ParLift2) = Seq.map2 f x y static member ParLift2 (f, (x: NonEmptySeq<_> , y: NonEmptySeq<_> ), _mthd: ParLift2) = NonEmptySeq.map2 f x y - // static member ParLift2 (f, (x: IEnumerator<_> , y: IEnumerator<_> ), _mthd: ParLift2) = Enumerator.map2 f x y + static member ParLift2 (f, (x: IEnumerator<_> , y: IEnumerator<_> ), _mthd: ParLift2) = Enumerator.map2 f x y static member ParLift2 (f, (x , y ), _mthd: ParLift2) = List.map2Shortest f x y - // static member ParLift2 (f, (x , y ), _mthd: ParLift2) = Array.lift2 f x y - // static member ParLift2 (f, (x: 'R -> 'T , y: 'R -> 'U ), _mthd: ParLift2) = fun a -> f (x a) (y a) - // static member inline ParLift2 (f, ((a: 'Monoid, x: 'T) , (b: 'Monoid, y: 'U) ), _mthd: ParLift2) = Plus.Invoke a b, f x y - // static member inline ParLift2 (f, (struct (a: 'Monoid, x: 'T), struct (b: 'Monoid, y: 'U)), _mthd: ParLift2) = struct (Plus.Invoke a b, f x y) + static member ParLift2 (f, (x , y ), _mthd: ParLift2) = Array.lift2 f x y + static member ParLift2 (f, (x: 'R -> 'T , y: 'R -> 'U ), _mthd: ParLift2) = fun a -> f (x a) (y a) + static member inline ParLift2 (f, ((a: 'Monoid, x: 'T) , (b: 'Monoid, y: 'U) ), _mthd: ParLift2) = Plus.Invoke a b, f x y + static member inline ParLift2 (f, (struct (a: 'Monoid, x: 'T), struct (b: 'Monoid, y: 'U)), _mthd: ParLift2) = struct (Plus.Invoke a b, f x y) #if !FABLE_COMPILER static member ParLift2 (f, (x: Task<'T> , y: Task<'U> ), _mthd: ParLift2) = Task.map2 f x y #endif @@ -148,11 +148,11 @@ type ParLift2 = static member ParLift2 (f, (x: ValueTask<'T> , y: ValueTask<'U> ), _mthd: ParLift2) = ValueTask.map2 f x y #endif static member ParLift2 (f, (x , y ), _mthd: ParLift2) = Async.map2 f x y - // static member ParLift2 (f, (x , y ), _mthd: ParLift2) = Option.map2 f x y + static member ParLift2 (f, (x , y ), _mthd: ParLift2) = Option.map2 f x y - // #if !FABLE_COMPILER - // static member ParLift2 (f, (x , y ), _mthd: ParLift2) = ValueOption.map2 f x y - // #endif + #if !FABLE_COMPILER + static member ParLift2 (f, (x , y ), _mthd: ParLift2) = ValueOption.map2 f x y + #endif static member inline ParLift2 (f, (x: Result<'T,'Error> , y: Result<'U,'Error> ), _mthd: ParLift2) = Result.apply2With Plus.Invoke f x y static member inline ParLift2 (f, (x: Choice<'T,'Error> , y: Choice<'U,'Error> ), _mthd: ParLift2) = Choice.map2 f x y static member ParLift2 (f, (x: Map<'Key,'T> , y : Map<'Key,'U> ), _mthd: ParLift2) = Map.mapValues2 f x y @@ -182,12 +182,12 @@ type ParLift3 = static member ParLift3 (f, (x: Lazy<_> , y: Lazy<_> , z: Lazy<_> ), _mthd: ParLift3) = Lazy.map3 f x y z static member ParLift3 (f, (x: seq<_> , y: seq<_> , z: seq<_> ), _mthd: ParLift3) = Seq.map3 f x y z static member ParLift3 (f, (x: NonEmptySeq<_> , y: NonEmptySeq<_> , z: NonEmptySeq<_> ), _mthd: ParLift3) = NonEmptySeq.map3 f x y z - // static member ParLift3 (f, (x: IEnumerator<_> , y: IEnumerator<_> , z: IEnumerator<_> ), _mthd: ParLift3) = Enumerator.map3 f x y z + static member ParLift3 (f, (x: IEnumerator<_> , y: IEnumerator<_> , z: IEnumerator<_> ), _mthd: ParLift3) = Enumerator.map3 f x y z static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = List.map3Shortest f x y z - // static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = Array.lift3 f x y z - // member ParLift3 (f, (x: 'R -> 'T , y: 'R -> 'U , z: 'R -> 'V ), _mthd: ParLift3) = fun a -> f (x a) (y a) (z a) - // member inline ParLift3 (f, ((a: 'Monoid, x: 'T) , (b: 'Monoid, y: 'U) , (c: 'Monoid, z: 'U) ), _mthd: ParLift3) = Plus.Invoke (Plus.Invoke a b) c, f x y z - // member inline ParLift3 (f, (struct (a: 'Monoid, x: 'T), struct (b: 'Monoid, y: 'U), struct (c: 'Monoid, z: 'U)), _mthd: ParLift3) = struct (Plus.Invoke (Plus.Invoke a b) c, f x y z) + static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = Array.lift3 f x y z + static member ParLift3 (f, (x: 'R -> 'T , y: 'R -> 'U , z: 'R -> 'V ), _mthd: ParLift3) = fun a -> f (x a) (y a) (z a) + static member inline ParLift3 (f, ((a: 'Monoid, x: 'T) , (b: 'Monoid, y: 'U) , (c: 'Monoid, z: 'U) ), _mthd: ParLift3) = Plus.Invoke (Plus.Invoke a b) c, f x y z + static member inline ParLift3 (f, (struct (a: 'Monoid, x: 'T), struct (b: 'Monoid, y: 'U), struct (c: 'Monoid, z: 'U)), _mthd: ParLift3) = struct (Plus.Invoke (Plus.Invoke a b) c, f x y z) #if !FABLE_COMPILER static member ParLift3 (f, (x: Task<'T> , y: Task<'U> , z: Task<'V> ), _mthd: ParLift3) = Task.map3 f x y z #endif @@ -195,19 +195,19 @@ type ParLift3 = static member ParLift3 (f, (x: ValueTask<'T> , y: ValueTask<'U> , z: ValueTask<'V> ), _mthd: ParLift3) = ValueTask.map3 f x y z #endif static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = Async.map3 f x y z - // static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = Option.map3 f x y z + static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = Option.map3 f x y z - // #if !FABLE_COMPILER - // static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = ValueOption.map3 f x y z - // #endif + #if !FABLE_COMPILER + static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = ValueOption.map3 f x y z + #endif static member inline ParLift3 (f, (x: Result<'T,'Error> , y: Result<'U,'Error> , z: Result<'V, 'Error> ), _mthd: ParLift3) = Result.apply3With Plus.Invoke f x y z static member inline ParLift3 (f, (x: Choice<'T,'Error> , y: Choice<'U,'Error> , z: Choice<'V, 'Error> ), _mthd: ParLift3) = Choice.apply3With Plus.Invoke f x y z - // static member ParLift3 (f, (x: Map<'Key,'T> , y: Map<'Key,'U> , z: Map<'Key, 'V> ), _mthd: ParLift3) = Map.mapValues3 f x y z - // static member ParLift3 (f, (x: Dictionary<'Key,'T>, y: Dictionary<'Key,'U>, z: Dictionary<'Key, 'V>), _mthd: ParLift3) = Dictionary.map3 f x y z - // #if !FABLE_COMPILER - // static member ParLift3 (f, (x: Expr<'T> , y: Expr<'U> , z: Expr<'V> ), _mthd: ParLift3) = <@ f %x %y %z @> - // #endif - // static member ParLift3 (f, (x: ResizeArray<'T> , y: ResizeArray<'U> , z: ResizeArray<'V> ), _mthd: ParLift3) = ResizeArray.lift3 f x y z + static member ParLift3 (f, (x: Map<'Key,'T> , y: Map<'Key,'U> , z: Map<'Key, 'V> ), _mthd: ParLift3) = Map.mapValues3 f x y z + static member ParLift3 (f, (x: Dictionary<'Key,'T>, y: Dictionary<'Key,'U>, z: Dictionary<'Key, 'V>), _mthd: ParLift3) = Dictionary.map3 f x y z + #if !FABLE_COMPILER + static member ParLift3 (f, (x: Expr<'T> , y: Expr<'U> , z: Expr<'V> ), _mthd: ParLift3) = <@ f %x %y %z @> + #endif + static member ParLift3 (f, (x: ResizeArray<'T> , y: ResizeArray<'U> , z: ResizeArray<'V> ), _mthd: ParLift3) = ResizeArray.lift3 f x y z static member inline Invoke (f: 'T -> 'U -> 'V -> 'W) (x: '``ParApplicative<'T>``) (y: '``ParApplicative<'U>``) (z: '``ParApplicative<'V>``): '``ParApplicative<'W>`` = let inline call (mthd : ^M, input1: ^I1, input2: ^I2, input3: ^I3, _output: ^R) = @@ -228,11 +228,11 @@ type IsParLeftZero = static member IsParLeftZero (_: ref> , _mthd: IsParLeftZero) = false static member IsParLeftZero (_: ref>, _mthd: IsParLeftZero) = false static member IsParLeftZero (_: ref> , _mthd: IsParLeftZero) = false - // static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = Array.isEmpty t.Value - // static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = Option.isNone t.Value - // #if !FABLE_COMPILER - // static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = ValueOption.isNone t.Value - // #endif + static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = Array.isEmpty t.Value + static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = Option.isNone t.Value + #if !FABLE_COMPILER + static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = ValueOption.isNone t.Value + #endif static member IsParLeftZero (_: ref> , _mthd: IsParLeftZero) = false static member IsParLeftZero (_: ref> , _mthd: IsParLeftZero) = false From f604caa034baf3a30013813008b055c1f9de6579 Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Fri, 13 Oct 2023 07:27:36 +0200 Subject: [PATCH 03/27] + operator --- src/FSharpPlus/Control/Parallel.fs | 6 +++--- src/FSharpPlus/Operators.fs | 7 +++++++ 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/src/FSharpPlus/Control/Parallel.fs b/src/FSharpPlus/Control/Parallel.fs index b4b849661..f74229ffc 100644 --- a/src/FSharpPlus/Control/Parallel.fs +++ b/src/FSharpPlus/Control/Parallel.fs @@ -34,9 +34,9 @@ type ParReturn = #if NETSTANDARD2_1 && !FABLE_COMPILER static member ParReturn (_: 'T ValueTask , _: ParReturn ) = fun (x: 'T) -> ValueTask<'T> x : 'T ValueTask #endif - static member inline ParReturn (_: option<'a> , _: ParReturn ) = fun x -> Some () : option<'a> - static member inline ParReturn (_ : voption<'a> , _: ParReturn ) = fun x -> ValueSome (Zero.Invoke ()) : voption<'a> - static member ParReturn (_: list<'a> , _: ParReturn ) = fun x -> List.cycle [x] : list<'a> + static member inline ParReturn (_: option<'a> , _: ParReturn ) = fun x -> Some x : option<'a> + static member inline ParReturn (_: voption<'a> , _: ParReturn ) = fun x -> ValueSome x : voption<'a> + static member ParReturn (_: list<'a> , _: ParReturn ) = fun x -> List.cycle [x] : list<'a> static member ParReturn (_: 'a [] , _: ParReturn ) = fun x -> [|x|] : 'a [] static member ParReturn (_: 'r -> 'a , _: ParReturn ) = Prelude.const': 'a -> 'r -> _ static member inline ParReturn (_: 'm * 'a , _: ParReturn ) = fun (x: 'a) -> (Zero.Invoke (): 'm), x diff --git a/src/FSharpPlus/Operators.fs b/src/FSharpPlus/Operators.fs index 0501efa6a..959e6f971 100644 --- a/src/FSharpPlus/Operators.fs +++ b/src/FSharpPlus/Operators.fs @@ -178,6 +178,13 @@ module Operators = /// Applicative let inline (<*>) (f: '``Applicative<'T -> 'U>``) (x: '``Applicative<'T>``) : '``Applicative<'U>`` = Apply.Invoke f x : '``Applicative<'U>`` + /// + /// Apply a lifted argument to a lifted function: f </> arg. + /// Same as <*> but for parallel applicatives. + /// + /// Applicative + let inline () (f: '``Applicative<'T -> 'U>``) (x: '``Applicative<'T>``) : '``Applicative<'U>`` = ParApply.Invoke f x : '``Applicative<'U>`` + /// /// Applies 2 lifted arguments to a non-lifted function. Equivalent to map2 in non list-like types. /// From 4a3602053717a1913ab31cb74f34413186475776 Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Fri, 13 Oct 2023 08:34:02 +0200 Subject: [PATCH 04/27] + asyncs --- src/FSharpPlus/Control/Parallel.fs | 6 +++--- src/FSharpPlus/Extensions/Async.fs | 33 +++++++++++++++++++++++++++--- 2 files changed, 33 insertions(+), 6 deletions(-) diff --git a/src/FSharpPlus/Control/Parallel.fs b/src/FSharpPlus/Control/Parallel.fs index f74229ffc..56925d5b1 100644 --- a/src/FSharpPlus/Control/Parallel.fs +++ b/src/FSharpPlus/Control/Parallel.fs @@ -74,7 +74,7 @@ type ParApply = #if NETSTANDARD2_1 && !FABLE_COMPILER static member ```` (f: ValueTask<_> , x: ValueTask<'T> , []_output: ValueTask<'U> , []_mthd: ParApply) = ValueTask.apply f x : ValueTask<'U> #endif - static member ```` (f: Async<_> , x: Async<'T> , []_output: Async<'U> , []_mthd: ParApply) = Async.apply f x : Async<'U> + static member ```` (f: Async<_> , x: Async<'T> , []_output: Async<'U> , []_mthd: ParApply) = Async.parMap2 (<|) f x : Async<'U> static member ```` (f: option<_> , x: option<'T> , []_output: option<'U> , []_mthd: ParApply) = Option.apply f x : option<'U> static member ```` (f: voption<_> , x: voption<'T> , []_output: voption<'U> , []_mthd: ParApply) = ValueOption.apply f x : voption<'U> static member inline ```` (f: Result<_,'E> , x: Result<'T,'E> , []_output: Result<'b,'E> , []_mthd: ParApply) = Result.apply2With Plus.Invoke (<|) f x : Result<'U, 'E> @@ -147,7 +147,7 @@ type ParLift2 = #if NETSTANDARD2_1 && !FABLE_COMPILER static member ParLift2 (f, (x: ValueTask<'T> , y: ValueTask<'U> ), _mthd: ParLift2) = ValueTask.map2 f x y #endif - static member ParLift2 (f, (x , y ), _mthd: ParLift2) = Async.map2 f x y + static member ParLift2 (f, (x , y ), _mthd: ParLift2) = Async.parMap2 f x y static member ParLift2 (f, (x , y ), _mthd: ParLift2) = Option.map2 f x y #if !FABLE_COMPILER @@ -194,7 +194,7 @@ type ParLift3 = #if NETSTANDARD2_1 && !FABLE_COMPILER static member ParLift3 (f, (x: ValueTask<'T> , y: ValueTask<'U> , z: ValueTask<'V> ), _mthd: ParLift3) = ValueTask.map3 f x y z #endif - static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = Async.map3 f x y z + static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = Async.parMap3 f x y z static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = Option.map3 f x y z #if !FABLE_COMPILER diff --git a/src/FSharpPlus/Extensions/Async.fs b/src/FSharpPlus/Extensions/Async.fs index 09fc152ed..9ce9d70e6 100644 --- a/src/FSharpPlus/Extensions/Async.fs +++ b/src/FSharpPlus/Extensions/Async.fs @@ -17,7 +17,15 @@ module Async = let map2 f x y = async { let! a = x let! b = y - return f a b} + return f a b } + + let parMap2 f c1 c2 = async { + let! ct = Async.CancellationToken + let x = Async.StartImmediateAsTask (c1, ct) + let y = Async.StartImmediateAsTask (c2, ct) + let! x' = Async.AwaitTask x + let! y' = Async.AwaitTask y + return f x' y' } /// Creates an async workflow from three workflows 'x', 'y' and 'z', mapping its results with 'f'. /// Workflows are run in sequence. @@ -29,13 +37,32 @@ module Async = let! a = x let! b = y let! c = z - return f a b c} + return f a b c } + + let parMap3 f c1 c2 c3 = async { + let! ct = Async.CancellationToken + let x = Async.StartImmediateAsTask (c1, ct) + let y = Async.StartImmediateAsTask (c2, ct) + let z = Async.StartImmediateAsTask (c3, ct) + let! x' = Async.AwaitTask x + let! y' = Async.AwaitTask y + let! z' = Async.AwaitTask z + return f x' y' z' } /// Creates an async workflow from two workflows 'x' and 'y', tupling its results. let zip x y = async { let! a = x let! b = y - return a, b} + return a, b } + + /// Creates an async-parallel workflow from two workflows 'x' and 'y', tupling its results. + let parZip c1 c2 = async { + let! ct = Async.CancellationToken + let x = Async.StartImmediateAsTask (c1, ct) + let y = Async.StartImmediateAsTask (c2, ct) + let! x' = Async.AwaitTask x + let! y' = Async.AwaitTask y + return x', y' } /// Flatten two nested asyncs into one. let join x = async.Bind (x, id) From f7c72094d398568129ce2d8b533c77331d4dc53d Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Sun, 15 Oct 2023 08:03:15 +0200 Subject: [PATCH 05/27] Async.pmapX --- src/FSharpPlus/Control/Parallel.fs | 6 ++-- src/FSharpPlus/Extensions/Async.fs | 49 ++++++++++++++++++++++-------- 2 files changed, 39 insertions(+), 16 deletions(-) diff --git a/src/FSharpPlus/Control/Parallel.fs b/src/FSharpPlus/Control/Parallel.fs index 56925d5b1..e29a2d0f8 100644 --- a/src/FSharpPlus/Control/Parallel.fs +++ b/src/FSharpPlus/Control/Parallel.fs @@ -74,7 +74,7 @@ type ParApply = #if NETSTANDARD2_1 && !FABLE_COMPILER static member ```` (f: ValueTask<_> , x: ValueTask<'T> , []_output: ValueTask<'U> , []_mthd: ParApply) = ValueTask.apply f x : ValueTask<'U> #endif - static member ```` (f: Async<_> , x: Async<'T> , []_output: Async<'U> , []_mthd: ParApply) = Async.parMap2 (<|) f x : Async<'U> + static member ```` (f: Async<_> , x: Async<'T> , []_output: Async<'U> , []_mthd: ParApply) = Async.pmap2 (<|) f x : Async<'U> static member ```` (f: option<_> , x: option<'T> , []_output: option<'U> , []_mthd: ParApply) = Option.apply f x : option<'U> static member ```` (f: voption<_> , x: voption<'T> , []_output: voption<'U> , []_mthd: ParApply) = ValueOption.apply f x : voption<'U> static member inline ```` (f: Result<_,'E> , x: Result<'T,'E> , []_output: Result<'b,'E> , []_mthd: ParApply) = Result.apply2With Plus.Invoke (<|) f x : Result<'U, 'E> @@ -147,7 +147,7 @@ type ParLift2 = #if NETSTANDARD2_1 && !FABLE_COMPILER static member ParLift2 (f, (x: ValueTask<'T> , y: ValueTask<'U> ), _mthd: ParLift2) = ValueTask.map2 f x y #endif - static member ParLift2 (f, (x , y ), _mthd: ParLift2) = Async.parMap2 f x y + static member ParLift2 (f, (x , y ), _mthd: ParLift2) = Async.pmap2 f x y static member ParLift2 (f, (x , y ), _mthd: ParLift2) = Option.map2 f x y #if !FABLE_COMPILER @@ -194,7 +194,7 @@ type ParLift3 = #if NETSTANDARD2_1 && !FABLE_COMPILER static member ParLift3 (f, (x: ValueTask<'T> , y: ValueTask<'U> , z: ValueTask<'V> ), _mthd: ParLift3) = ValueTask.map3 f x y z #endif - static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = Async.parMap3 f x y z + static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = Async.pmap3 f x y z static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = Option.map3 f x y z #if !FABLE_COMPILER diff --git a/src/FSharpPlus/Extensions/Async.fs b/src/FSharpPlus/Extensions/Async.fs index 9ce9d70e6..6d9a68711 100644 --- a/src/FSharpPlus/Extensions/Async.fs +++ b/src/FSharpPlus/Extensions/Async.fs @@ -10,7 +10,7 @@ module Async = let map f x = async.Bind (x, async.Return << f) /// Creates an async workflow from two workflows 'x' and 'y', mapping its results with 'f'. - /// Workflows are run in sequence. + /// Workflows are run in sequence. For parallel use pmap2 /// The mapping function. /// First async workflow. /// Second async workflow. @@ -19,16 +19,25 @@ module Async = let! b = y return f a b } - let parMap2 f c1 c2 = async { + /// Creates an async workflow from two workflows 'x' and 'y', mapping its results with 'f'. + /// Similar to map2 but workflows are run in parallel. + /// The mapping function. + /// First async workflow. + /// Second async workflow. + #if FABLE_COMPILER + let pmap2 f x y = map2 f x y + #else + let pmap2 f x y = async { let! ct = Async.CancellationToken - let x = Async.StartImmediateAsTask (c1, ct) - let y = Async.StartImmediateAsTask (c2, ct) + let x = Async.StartImmediateAsTask (x, ct) + let y = Async.StartImmediateAsTask (y, ct) let! x' = Async.AwaitTask x let! y' = Async.AwaitTask y return f x' y' } - + #endif + /// Creates an async workflow from three workflows 'x', 'y' and 'z', mapping its results with 'f'. - /// Workflows are run in sequence. + /// Workflows are run in sequence. For parallel use pmap3 /// The mapping function. /// First async workflow. /// Second async workflow. @@ -39,15 +48,25 @@ module Async = let! c = z return f a b c } - let parMap3 f c1 c2 c3 = async { + /// Creates an async workflow from three workflows 'x', 'y' and 'z', mapping its results with 'f'. + /// Similar to map3 but workflows are run in parallel. + /// The mapping function. + /// First async workflow. + /// Second async workflow. + /// third async workflow. + #if FABLE_COMPILER + let pmap3 f x y z = map3 f x y z + #else + let pmap3 f x y z = async { let! ct = Async.CancellationToken - let x = Async.StartImmediateAsTask (c1, ct) - let y = Async.StartImmediateAsTask (c2, ct) - let z = Async.StartImmediateAsTask (c3, ct) + let x = Async.StartImmediateAsTask (x, ct) + let y = Async.StartImmediateAsTask (y, ct) + let z = Async.StartImmediateAsTask (z, ct) let! x' = Async.AwaitTask x let! y' = Async.AwaitTask y let! z' = Async.AwaitTask z return f x' y' z' } + #endif /// Creates an async workflow from two workflows 'x' and 'y', tupling its results. let zip x y = async { @@ -56,13 +75,17 @@ module Async = return a, b } /// Creates an async-parallel workflow from two workflows 'x' and 'y', tupling its results. - let parZip c1 c2 = async { + #if FABLE_COMPILER + let pzip x y = zip x y + #else + let pzip x y = async { let! ct = Async.CancellationToken - let x = Async.StartImmediateAsTask (c1, ct) - let y = Async.StartImmediateAsTask (c2, ct) + let x = Async.StartImmediateAsTask (x, ct) + let y = Async.StartImmediateAsTask (y, ct) let! x' = Async.AwaitTask x let! y' = Async.AwaitTask y return x', y' } + #endif /// Flatten two nested asyncs into one. let join x = async.Bind (x, id) From 0b8075ee8a5446220b25487d5fb58b393fbbf076 Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Tue, 9 Jan 2024 09:26:28 +0100 Subject: [PATCH 06/27] Re-route non "changed" applicatives --- src/FSharpPlus/Control/Parallel.fs | 146 ++++++++++++----------------- 1 file changed, 61 insertions(+), 85 deletions(-) diff --git a/src/FSharpPlus/Control/Parallel.fs b/src/FSharpPlus/Control/Parallel.fs index e29a2d0f8..8cf8b9b24 100644 --- a/src/FSharpPlus/Control/Parallel.fs +++ b/src/FSharpPlus/Control/Parallel.fs @@ -7,6 +7,7 @@ open System.Threading.Tasks open Microsoft.FSharp.Quotations open FSharpPlus.Internals +open FSharpPlus.Internals.Prelude open FSharpPlus open FSharpPlus.Data @@ -25,29 +26,29 @@ type ParReturn = static member ParReturn (_: seq<'a> , _: Default2) = fun x -> Seq.initInfinite (fun _ -> x) : seq<'a> static member ParReturn (_: NonEmptySeq<'a>, _: Default2) = fun x -> NonEmptySeq.initInfinite (fun _ -> x) : NonEmptySeq<'a> - static member ParReturn (_: IEnumerator<'a>, _: Default2) = fun x -> Enumerator.upto None (fun _ -> x) : IEnumerator<'a> + static member ParReturn (x: IEnumerator<'a>, y: Default2) = Return.Return (x, y) static member inline ParReturn (_: 'R , _: Default1) = fun (x: 'T) -> ParReturn.InvokeOnInstance x : 'R - static member ParReturn (_: Lazy<'a> , _: ParReturn ) = fun x -> Lazy<_>.CreateFromValue x : Lazy<'a> + static member ParReturn (x: Lazy<'a> , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) #if !FABLE_COMPILER static member ParReturn (_: 'T Task , _: ParReturn ) = fun x -> Task.FromResult x : 'T Task #endif #if NETSTANDARD2_1 && !FABLE_COMPILER static member ParReturn (_: 'T ValueTask , _: ParReturn ) = fun (x: 'T) -> ValueTask<'T> x : 'T ValueTask #endif - static member inline ParReturn (_: option<'a> , _: ParReturn ) = fun x -> Some x : option<'a> - static member inline ParReturn (_: voption<'a> , _: ParReturn ) = fun x -> ValueSome x : voption<'a> + static member inline ParReturn (x: option<'a> , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) + static member inline ParReturn (x: voption<'a> , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) static member ParReturn (_: list<'a> , _: ParReturn ) = fun x -> List.cycle [x] : list<'a> - static member ParReturn (_: 'a [] , _: ParReturn ) = fun x -> [|x|] : 'a [] - static member ParReturn (_: 'r -> 'a , _: ParReturn ) = Prelude.const': 'a -> 'r -> _ - static member inline ParReturn (_: 'm * 'a , _: ParReturn ) = fun (x: 'a) -> (Zero.Invoke (): 'm), x - static member inline ParReturn (_: struct ('m * 'a), _: ParReturn ) = fun (x: 'a) -> struct ((Zero.Invoke (): 'm), x) + static member ParReturn (x: 'a [] , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) + static member ParReturn (x: 'r -> 'a , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) + static member inline ParReturn (x: 'm * 'a , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) + static member inline ParReturn (x: struct ('m * 'a), _: ParReturn ) = Return.Return (x, Unchecked.defaultof) static member ParReturn (_: 'a Async , _: ParReturn ) = fun (x: 'a) -> async.Return x - static member inline ParReturn (_: Result<'t,'e> , _: ParReturn ) = fun x -> if false then Error (Zero.Invoke (): 'e) else Ok x : Result<'t,'e> - static member inline ParReturn (_: Choice<'t,'e> , _: ParReturn ) = fun x -> if false then Choice2Of2 (Zero.Invoke (): 'e) else Choice1Of2 x : Choice<'t,'e> + static member inline ParReturn (_: Result<'t, 'e> , _: ParReturn ) = fun x -> if opaqueId false then Error (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e> : 'e) else Ok x : Result<'t,'e> + static member inline ParReturn (_: Choice<'t, 'e> , _: ParReturn ) = fun x -> if opaqueId false then Choice2Of2 (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e> : 'e) else Choice1Of2 x : Choice<'t,'e> #if !FABLE_COMPILER - static member ParReturn (_: Expr<'a> , _: ParReturn ) = fun x -> Expr.Cast<'a> (Expr.Value (x: 'a)) + static member ParReturn (x: Expr<'a> , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) #endif - static member ParReturn (_: ResizeArray<'a>, _: ParReturn ) = fun x -> ResizeArray<'a> (Seq.singleton x) + static member ParReturn (x: ResizeArray<'a>, _: ParReturn ) = Return.Return (x, Unchecked.defaultof) #endif @@ -59,15 +60,15 @@ type ParApply = static member inline ```` (f: '``Monad<'T->'U>`` , x: '``Monad<'T>`` , []_output: '``Monad<'U>`` , []_mthd:Default2) : '``Monad<'U>`` = Bind.InvokeOnInstance f (fun (x1: 'T->'U) -> Bind.InvokeOnInstance x (fun x2 -> ParReturn.InvokeOnInstance (x1 x2))) static member inline ```` (f: '``ParApplicative<'T->'U>``, x: '``ParApplicative<'T>``, []_output: '``ParApplicative<'U>``, []_mthd:Default1) : '``ParApplicative<'U>`` = ((^``ParApplicative<'T->'U>`` or ^``ParApplicative<'T>`` or ^``ParApplicative<'U>``) : (static member (<*>) : _*_ -> _) f, x) - static member ```` (f: Lazy<'T->'U> , x: Lazy<'T> , []_output: Lazy<'U> , []_mthd: ParApply) = Lazy.apply f x : Lazy<'U> + static member ```` (f: Lazy<'T->'U> , x: Lazy<'T> , []_output: Lazy<'U> , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) static member ```` (f: seq<_> , x: seq<'T> , []_output: seq<'U> , []_mthd: ParApply) = Seq.map2 (<|) f x : seq<'U> static member ```` (f: NonEmptySeq<_> , x: NonEmptySeq<'T> , []_output: NonEmptySeq<'U> , []_mthd: ParApply) = NonEmptySeq.map2 (<|) f x : NonEmptySeq<'U> - static member ```` (f: IEnumerator<_> , x: IEnumerator<'T> , []_output: IEnumerator<'U> , []_mthd: ParApply) = Enumerator.map2 id f x : IEnumerator<'U> + static member ```` (f: IEnumerator<_> , x: IEnumerator<'T> , []_output: IEnumerator<'U> , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) static member ```` (f: list<_> , x: list<'T> , []_output: list<'U> , []_mthd: ParApply) = List.map2Shortest (<|) f x : list<'U> - static member ```` (f: _ [] , x: 'T [] , []_output: 'U [] , []_mthd: ParApply) = Array.apply f x : 'U [] - static member ```` (f: 'r -> _ , g: _ -> 'T , []_output: 'r -> 'U , []_mthd: ParApply) = fun x -> let f' = f x in f' (g x) : 'U - static member inline ```` ((a: 'Monoid, f) , (b: 'Monoid, x: 'T) , []_output: 'Monoid * 'U , []_mthd: ParApply) = (Plus.Invoke a b, f x) : 'Monoid *'U - static member inline ```` (struct (a: 'Monoid, f), struct (b: 'Monoid, x: 'T), []_output: struct ('Monoid * 'U), []_mthd: ParApply) = struct (Plus.Invoke a b, f x) : struct ('Monoid * 'U) + static member ```` (f: _ [] , x: 'T [] , []_output: 'U [] , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ```` (f: 'r -> _ , x: _ -> 'T , []_output: 'r -> 'U , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member inline ```` (f: 'Monoid * _ , x: ('Monoid * 'T) , []_output: 'Monoid * 'U , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member inline ```` (f: struct ('Monoid * _), x: struct ('Monoid * 'T), []_output: struct ('Monoid * 'U), []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) #if !FABLE_COMPILER static member ```` (f: Task<_> , x: Task<'T> , []_output: Task<'U> , []_mthd: ParApply) = Task.apply f x : Task<'U> #endif @@ -75,46 +76,21 @@ type ParApply = static member ```` (f: ValueTask<_> , x: ValueTask<'T> , []_output: ValueTask<'U> , []_mthd: ParApply) = ValueTask.apply f x : ValueTask<'U> #endif static member ```` (f: Async<_> , x: Async<'T> , []_output: Async<'U> , []_mthd: ParApply) = Async.pmap2 (<|) f x : Async<'U> - static member ```` (f: option<_> , x: option<'T> , []_output: option<'U> , []_mthd: ParApply) = Option.apply f x : option<'U> - static member ```` (f: voption<_> , x: voption<'T> , []_output: voption<'U> , []_mthd: ParApply) = ValueOption.apply f x : voption<'U> + static member ```` (f: option<_> , x: option<'T> , []_output: option<'U> , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ```` (f: voption<_> , x: voption<'T> , []_output: voption<'U> , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) static member inline ```` (f: Result<_,'E> , x: Result<'T,'E> , []_output: Result<'b,'E> , []_mthd: ParApply) = Result.apply2With Plus.Invoke (<|) f x : Result<'U, 'E> static member inline ```` (f: Choice<_,'E> , x: Choice<'T,'E> , []_output: Choice<'b,'E> , []_mthd: ParApply) = Choice.apply2With Plus.Invoke (<|) f x : Choice<'U, 'E> - static member inline ```` (KeyValue(a: 'Key, f), KeyValue(b: 'Key, x: 'T), []_output: KeyValuePair<'Key,'U>, []_mthd: ParApply) : KeyValuePair<'Key,'U> = KeyValuePair (Plus.Invoke a b, f x) - - static member ```` (f: Map<'Key,_> , x: Map<'Key,'T> , []_output: Map<'Key,'U> , []_mthd: ParApply) : Map<'Key,'U> = Map (seq { - for KeyValue(k, vf) in f do - match Map.tryFind k x with - | Some vx -> yield k, vf vx - | _ -> () }) - - static member ```` (f: Dictionary<'Key,_>, x: Dictionary<'Key,'T> , []_output: Dictionary<'Key,'U> , []_mthd: ParApply) : Dictionary<'Key,'U> = - let dct = Dictionary () - for KeyValue(k, vf) in f do - match x.TryGetValue k with - | true, vx -> dct.Add (k, vf vx) - | _ -> () - dct - - static member ```` (f: IDictionary<'Key,_>, x: IDictionary<'Key,'T> , []_output: IDictionary<'Key,'U> , []_mthd: ParApply) : IDictionary<'Key,'U> = - let dct = Dictionary () - for KeyValue(k, vf) in f do - match x.TryGetValue k with - | true, vx -> dct.Add (k, vf vx) - | _ -> () - dct :> IDictionary<'Key,'U> - - static member ```` (f: IReadOnlyDictionary<'Key,_>, x: IReadOnlyDictionary<'Key,'T> , []_output: IReadOnlyDictionary<'Key,'U> , []_mthd: ParApply) : IReadOnlyDictionary<'Key,'U> = - let dct = Dictionary () - for KeyValue(k, vf) in f do - match x.TryGetValue k with - | true, vx -> dct.Add (k, vf vx) - | _ -> () - dct :> IReadOnlyDictionary<'Key,'U> + static member inline ```` (f: KeyValuePair<'Key,_>, x: KeyValuePair<'Key,'T>, []_output: KeyValuePair<'Key,'U>, []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + + static member ```` (f: Map<'Key,_> , x: Map<'Key,'T> , []_output: Map<'Key,'U> , []_mthd: ParApply) : Map<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ```` (f: Dictionary<'Key,_>, x: Dictionary<'Key,'T> , []_output: Dictionary<'Key,'U> , []_mthd: ParApply) : Dictionary<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ```` (f: IDictionary<'Key,_>, x: IDictionary<'Key,'T> , []_output: IDictionary<'Key,'U> , []_mthd: ParApply) : IDictionary<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ```` (f: IReadOnlyDictionary<'Key,_>, x: IReadOnlyDictionary<'Key,'T> , []_output: IReadOnlyDictionary<'Key,'U> , []_mthd: ParApply) : IReadOnlyDictionary<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) #if !FABLE_COMPILER - static member ```` (f: Expr<'T->'U>, x: Expr<'T>, []_output: Expr<'U>, []_mthd: ParApply) = Expr.Cast<'U> (Expr.Application (f, x)) + static member ```` (f: Expr<'T->'U>, x: Expr<'T>, []_output: Expr<'U>, []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) #endif - static member ```` (f: ('T->'U) ResizeArray, x: 'T ResizeArray, []_output: 'U ResizeArray, []_mthd: ParApply) = ResizeArray.apply f x : 'U ResizeArray + static member ```` (f: ('T->'U) ResizeArray, x: 'T ResizeArray, []_output: 'U ResizeArray, []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) static member inline Invoke (f: '``ParApplicative<'T -> 'U>``) (x: '``ParApplicative<'T>``) : '``ParApplicative<'U>`` = let inline call (mthd : ^M, input1: ^I1, input2: ^I2, output: ^R) = @@ -132,15 +108,15 @@ type ParApply = type ParLift2 = inherit Default1 - static member ParLift2 (f, (x: Lazy<_> , y: Lazy<_> ), _mthd: ParLift2) = Lazy.map2 f x y + static member ParLift2 (f, (x: Lazy<_> , y: Lazy<_> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) static member ParLift2 (f, (x: seq<_> , y: seq<_> ), _mthd: ParLift2) = Seq.map2 f x y static member ParLift2 (f, (x: NonEmptySeq<_> , y: NonEmptySeq<_> ), _mthd: ParLift2) = NonEmptySeq.map2 f x y - static member ParLift2 (f, (x: IEnumerator<_> , y: IEnumerator<_> ), _mthd: ParLift2) = Enumerator.map2 f x y + static member ParLift2 (f, (x: IEnumerator<_> , y: IEnumerator<_> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) static member ParLift2 (f, (x , y ), _mthd: ParLift2) = List.map2Shortest f x y - static member ParLift2 (f, (x , y ), _mthd: ParLift2) = Array.lift2 f x y - static member ParLift2 (f, (x: 'R -> 'T , y: 'R -> 'U ), _mthd: ParLift2) = fun a -> f (x a) (y a) - static member inline ParLift2 (f, ((a: 'Monoid, x: 'T) , (b: 'Monoid, y: 'U) ), _mthd: ParLift2) = Plus.Invoke a b, f x y - static member inline ParLift2 (f, (struct (a: 'Monoid, x: 'T), struct (b: 'Monoid, y: 'U)), _mthd: ParLift2) = struct (Plus.Invoke a b, f x y) + static member ParLift2 (f, (x: _ [] , y: _ [] ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member ParLift2 (f, (x: 'R -> 'T , y: 'R -> 'U ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member inline ParLift2 (f, (x: 'Monoid * 'T , y: 'Monoid * 'U ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member inline ParLift2 (f, (x: struct ('Monoid * 'T), y: struct ('Monoid * 'U)), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) #if !FABLE_COMPILER static member ParLift2 (f, (x: Task<'T> , y: Task<'U> ), _mthd: ParLift2) = Task.map2 f x y #endif @@ -148,19 +124,19 @@ type ParLift2 = static member ParLift2 (f, (x: ValueTask<'T> , y: ValueTask<'U> ), _mthd: ParLift2) = ValueTask.map2 f x y #endif static member ParLift2 (f, (x , y ), _mthd: ParLift2) = Async.pmap2 f x y - static member ParLift2 (f, (x , y ), _mthd: ParLift2) = Option.map2 f x y + static member ParLift2 (f, (x: option<_> , y: option<_> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) #if !FABLE_COMPILER - static member ParLift2 (f, (x , y ), _mthd: ParLift2) = ValueOption.map2 f x y + static member ParLift2 (f, (x: voption<_> , y: voption<_> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) #endif static member inline ParLift2 (f, (x: Result<'T,'Error> , y: Result<'U,'Error> ), _mthd: ParLift2) = Result.apply2With Plus.Invoke f x y static member inline ParLift2 (f, (x: Choice<'T,'Error> , y: Choice<'U,'Error> ), _mthd: ParLift2) = Choice.map2 f x y - static member ParLift2 (f, (x: Map<'Key,'T> , y : Map<'Key,'U> ), _mthd: ParLift2) = Map.mapValues2 f x y - static member ParLift2 (f, (x: Dictionary<'Key,'T>, y: Dictionary<'Key,'U>), _mthd: ParLift2) = Dictionary.map2 f x y + static member ParLift2 (f, (x: Map<'Key,'T> , y : Map<'Key,'U> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member ParLift2 (f, (x: Dictionary<'Key,'T>, y: Dictionary<'Key,'U>), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) #if !FABLE_COMPILER - static member ParLift2 (f, (x: Expr<'T> , y: Expr<'U> ), _mthd: ParLift2) = <@ f %x %y @> + static member ParLift2 (f, (x: Expr<'T> , y: Expr<'U> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) #endif - static member ParLift2 (f, (x: ResizeArray<'T> , y: ResizeArray<'U> ), _mthd: ParLift2) = ResizeArray.lift2 f x y + static member ParLift2 (f, (x: ResizeArray<'T> , y: ResizeArray<'U> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) static member inline Invoke (f: 'T -> 'U -> 'V) (x: '``ParApplicative<'T>``) (y: '``ParApplicative<'U>``) : '``ParApplicative<'V>`` = let inline call (mthd : ^M, input1: ^I1, input2: ^I2, _output: ^R) = @@ -174,20 +150,20 @@ type ParLift2 with static member inline ParLift2 (f, (x, y), _mthd: Default2) = (((ParReturn.InvokeOnInstance f, x) ||> ParApply.InvokeOnInstance), y) ||> ParApply.InvokeOnInstance static member inline ParLift2 (_, (_:'t when 't: null and 't: struct, _: ^u when ^u : null and ^u: struct), _mthd: Default1) = id - static member inline ParLift2 (f: 'T -> 'U -> 'V, (x: '``ParApplicative<'T>``, y: '``ParApplicative<'U>``) , _mthd: Default1) = ((^``ParApplicative<'T>`` or ^``ParApplicative<'U>`` ) : (static member ParLift2 : _*_*_ -> _) f, x, y) + static member inline ParLift2 (f: 'T -> 'U -> 'V, (x: '``ParApplicative<'T>``, y: '``ParApplicative<'U>``), _mthd: Default1) = ((^``ParApplicative<'T>`` or ^``ParApplicative<'U>`` ) : (static member ParLift2 : _*_*_ -> _) f, x, y) type ParLift3 = inherit Default1 - static member ParLift3 (f, (x: Lazy<_> , y: Lazy<_> , z: Lazy<_> ), _mthd: ParLift3) = Lazy.map3 f x y z + static member ParLift3 (f, (x: Lazy<_> , y: Lazy<_> , z: Lazy<_> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) static member ParLift3 (f, (x: seq<_> , y: seq<_> , z: seq<_> ), _mthd: ParLift3) = Seq.map3 f x y z static member ParLift3 (f, (x: NonEmptySeq<_> , y: NonEmptySeq<_> , z: NonEmptySeq<_> ), _mthd: ParLift3) = NonEmptySeq.map3 f x y z - static member ParLift3 (f, (x: IEnumerator<_> , y: IEnumerator<_> , z: IEnumerator<_> ), _mthd: ParLift3) = Enumerator.map3 f x y z + static member ParLift3 (f, (x: IEnumerator<_> , y: IEnumerator<_> , z: IEnumerator<_> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = List.map3Shortest f x y z - static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = Array.lift3 f x y z - static member ParLift3 (f, (x: 'R -> 'T , y: 'R -> 'U , z: 'R -> 'V ), _mthd: ParLift3) = fun a -> f (x a) (y a) (z a) - static member inline ParLift3 (f, ((a: 'Monoid, x: 'T) , (b: 'Monoid, y: 'U) , (c: 'Monoid, z: 'U) ), _mthd: ParLift3) = Plus.Invoke (Plus.Invoke a b) c, f x y z - static member inline ParLift3 (f, (struct (a: 'Monoid, x: 'T), struct (b: 'Monoid, y: 'U), struct (c: 'Monoid, z: 'U)), _mthd: ParLift3) = struct (Plus.Invoke (Plus.Invoke a b) c, f x y z) + static member ParLift3 (f, (x: _ [] , y: _ [] , z: _ [] ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member ParLift3 (f, (x: 'R -> 'T , y: 'R -> 'U , z: 'R -> 'V ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member inline ParLift3 (f, (x: 'Monoid * 'T , y: 'Monoid * 'U , z: 'Monoid * 'V ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member inline ParLift3 (f, (x: struct ('Monoid * 'T), y: struct ('Monoid * 'U), z: struct ('Monoid * 'T)), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) #if !FABLE_COMPILER static member ParLift3 (f, (x: Task<'T> , y: Task<'U> , z: Task<'V> ), _mthd: ParLift3) = Task.map3 f x y z #endif @@ -195,19 +171,19 @@ type ParLift3 = static member ParLift3 (f, (x: ValueTask<'T> , y: ValueTask<'U> , z: ValueTask<'V> ), _mthd: ParLift3) = ValueTask.map3 f x y z #endif static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = Async.pmap3 f x y z - static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = Option.map3 f x y z + static member ParLift3 (f, (x: option<_> , y: option<_> , z: option<_> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) #if !FABLE_COMPILER - static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = ValueOption.map3 f x y z + static member ParLift3 (f, (x: voption<_> , y: voption<_> , z: voption<_> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) #endif static member inline ParLift3 (f, (x: Result<'T,'Error> , y: Result<'U,'Error> , z: Result<'V, 'Error> ), _mthd: ParLift3) = Result.apply3With Plus.Invoke f x y z static member inline ParLift3 (f, (x: Choice<'T,'Error> , y: Choice<'U,'Error> , z: Choice<'V, 'Error> ), _mthd: ParLift3) = Choice.apply3With Plus.Invoke f x y z - static member ParLift3 (f, (x: Map<'Key,'T> , y: Map<'Key,'U> , z: Map<'Key, 'V> ), _mthd: ParLift3) = Map.mapValues3 f x y z - static member ParLift3 (f, (x: Dictionary<'Key,'T>, y: Dictionary<'Key,'U>, z: Dictionary<'Key, 'V>), _mthd: ParLift3) = Dictionary.map3 f x y z + static member ParLift3 (f, (x: Map<'Key,'T> , y: Map<'Key,'U> , z: Map<'Key, 'V> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member ParLift3 (f, (x: Dictionary<'Key,'T>, y: Dictionary<'Key,'U>, z: Dictionary<'Key, 'V>), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) #if !FABLE_COMPILER - static member ParLift3 (f, (x: Expr<'T> , y: Expr<'U> , z: Expr<'V> ), _mthd: ParLift3) = <@ f %x %y %z @> + static member ParLift3 (f, (x: Expr<'T> , y: Expr<'U> , z: Expr<'V> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) #endif - static member ParLift3 (f, (x: ResizeArray<'T> , y: ResizeArray<'U> , z: ResizeArray<'V> ), _mthd: ParLift3) = ResizeArray.lift3 f x y z + static member ParLift3 (f, (x: ResizeArray<'T> , y: ResizeArray<'U> , z: ResizeArray<'V> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) static member inline Invoke (f: 'T -> 'U -> 'V -> 'W) (x: '``ParApplicative<'T>``) (y: '``ParApplicative<'U>``) (z: '``ParApplicative<'V>``): '``ParApplicative<'W>`` = let inline call (mthd : ^M, input1: ^I1, input2: ^I2, input3: ^I3, _output: ^R) = @@ -220,18 +196,18 @@ type ParLift3 = type ParLift3 with static member inline ParLift3 (f, (x, y, z), _mthd: Default3) = ((((ParReturn.InvokeOnInstance f, x) ||> ParApply.InvokeOnInstance), y) ||> ParApply.InvokeOnInstance, z) ||> ParApply.InvokeOnInstance static member inline ParLift3 (_, (_:'t when 't: null and 't: struct, _: ^u when ^u : null and ^u: struct, _: ^v when ^v : null and ^v: struct), _mthd: Default1) = id - static member inline ParLift3 (f: 'T -> 'U -> 'V -> 'W, (x: '``ParApplicative<'T>``, y: '``ParApplicative<'U>``, z: '``ParApplicative<'V>``) , _mthd: Default1) = ((^``ParApplicative<'T>`` or ^``ParApplicative<'U>`` or ^``ParApplicative<'V>`` ) : (static member ParLift3 : _*_*_*_ -> _) f, x, y, z) + static member inline ParLift3 (f: 'T -> 'U -> 'V -> 'W, (x: '``ParApplicative<'T>``, y: '``ParApplicative<'U>``, z: '``ParApplicative<'V>``) , _mthd: Default1) = ((^``ParApplicative<'T>`` or ^``ParApplicative<'U>`` or ^``ParApplicative<'V>`` ) : (static member ParLift3 : _*_*_*_ -> _) f, x, y, z) type IsParLeftZero = inherit Default1 - static member IsParLeftZero (_: ref> , _mthd: IsParLeftZero) = false + static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = Seq.isEmpty t.Value static member IsParLeftZero (_: ref>, _mthd: IsParLeftZero) = false - static member IsParLeftZero (_: ref> , _mthd: IsParLeftZero) = false - static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = Array.isEmpty t.Value - static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = Option.isNone t.Value + static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = List.isEmpty t.Value + static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = IsLeftZero.IsLeftZero (t, Unchecked.defaultof) + static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = IsLeftZero.IsLeftZero (t, Unchecked.defaultof) #if !FABLE_COMPILER - static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = ValueOption.isNone t.Value + static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = IsLeftZero.IsLeftZero (t, Unchecked.defaultof) #endif static member IsParLeftZero (_: ref> , _mthd: IsParLeftZero) = false static member IsParLeftZero (_: ref> , _mthd: IsParLeftZero) = false @@ -249,7 +225,7 @@ type IsParLeftZero with static member inline IsParLeftZero (_: ref<'T> when 'T : struct , _mthd: Default4) = false static member inline IsParLeftZero (_: ref<'T> when 'T : not struct, _mthd: Default3) = false - // empty <*> f = empty ==> empty is left zero for <*> + // empty f = empty ==> empty is left zero for static member inline IsParLeftZero (t: ref<'``Alternative<'T>``> , _mthd: Default2) = (t.Value = Empty.InvokeOnInstance ()) static member inline IsParLeftZero (t: ref<'``ParApplicative<'T>``> , _mthd: Default1) = (^``ParApplicative<'T>`` : (static member IsParLeftZero : _ -> _) t.Value) From bdab9d7b2a94102e9d60f2daf9624d7f1a3f760b Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Tue, 9 Jan 2024 09:36:45 +0100 Subject: [PATCH 07/27] + CEs --- .../content/abstraction-par-applicative.fsx | 143 ++++++++++++++++++ src/FSharpPlus/Builders.fs | 13 ++ src/FSharpPlus/Operators.fs | 35 ++++- 3 files changed, 183 insertions(+), 8 deletions(-) create mode 100644 docsrc/content/abstraction-par-applicative.fsx diff --git a/docsrc/content/abstraction-par-applicative.fsx b/docsrc/content/abstraction-par-applicative.fsx new file mode 100644 index 000000000..59c56d5c7 --- /dev/null +++ b/docsrc/content/abstraction-par-applicative.fsx @@ -0,0 +1,143 @@ +(*** hide ***) +// This block of code is omitted in the generated HTML documentation. Use +// it to define helpers that you do not want to show in the documentation. +#r @"../../src/FSharpPlus/bin/Release/netstandard2.0/FSharpPlus.dll" + +(** +Par-Applicative +=============== +A functor with application, providing operations to embed pure expressions (``preturn``), parallel computations and combine their results (````). +___ +Minimal complete definition +--------------------------- + * ``preturn x``   /   ``result x`` + * ``() f x`` +*) +(** + static member ParReturn (x: 'T) : 'Applicative<'T> + static member () (f: 'Applicative<'T -> 'U>, x: 'Applicative<'T>) : 'Applicative<'U> +*) +(** +Note: ``preturn`` can't be used outside computation expressions, use ``result`` instead. + + +Other operations +---------------- + +* ``plift2`` +*) +(** + static member ParLift2 (f: 'T1 -> 'T2 -> 'T, x1: 'Applicative<'T1>, x2: 'Applicative<'T2>) : 'Applicative<'T> +*) +(** + + +Rules +----- +*) +(** + presult id v = v + presult (<<) u v w = u (v w) + presult f <*> presult x = presult (f x) + u <*> presult y = presult ((|>) y) u +*) +(** +Related Abstractions +-------------------- + - [Functor](abstraction-functor.html): A parallel applicative is a functor whose ``map`` operation can be splitted in ``preturn`` and ``()`` operations, + + - [Applicative](abstraction-applicative.html) : Parallel Applicatives are applicatives which usually don't form a [Monad](abstraction-monad.html). + +Concrete implementations +------------------------ +From F# + + - ``seq<'T>`` + - ``list<'T>`` + - ``array<'T>`` * + - ``'T [,]`` * + - ``'T [,,]`` * + - ``'T [,,,]`` * + - ``option<'T>`` * + - ``voption<'T>`` * + - ``IObservable<'T>`` + - ``Lazy<'T>`` * + - ``Async<'T>`` + - ``Result<'T,'U>`` + - ``Choice<'T,'U>`` + - ``KeyValuePair<'Key,'T>`` * + - ``'Monoid * 'T`` * + - ``ValueTuple<'Monoid, 'T>`` * + - ``Task<'T>`` + - ``ValueTask<'T>`` + - ``'R->'T`` * + - ``Expr<'T>`` * + - ``ResizeArray<'T>`` * + +From F#+ + + - [``Identity<'T>``](type-identity.html) + - [``Cont<'R,'T>``](type-cont.html) + - [``ContT<'R,'T>``](type-contt.html) + - [``Reader<'R,'T>``](type-reader.html) + - [``ReaderT<'R,'Monad<'T>>``](type-readert.html) + - [``Writer<'Monoid,'T>``](type-writer.html) + - [``WriterT<'Monad<'T * 'Monoid>>``](type-writert.html) + - [``State<'S,'T * 'S>``](type-state.html) + - [``StateT<'S,'Monad<'T * 'S>>``](type-statet.html) + - [``OptionT<'Monad>``](type-optiont.html) + - [``ValueOptionT<'Monad>``](type-valueoptiont.html) + - [``SeqT<'Monad>``](type-seqt.html) + - [``ListT<'Monad>``](type-listt.html) + - [``ResultT<'Monad>``](type-resultt.html) + - [``ChoiceT<'Monad>``](type-choicet.html) + - [``Free<'Functor<'T>,'T>``](type-free.html) + - [``NonEmptyList<'T>``](type-nonempty.html) + - [``Validation<'Error,'T>``](type-validation.html) + - [``ZipList<'T>``](type-ziplist.html) + - [``ParallelArray<'T>``](type-parallelarray.html) + - [``Const<'C,'T>``](type-const.html) + - [``Compose<'Applicative1<'Applicative2<'T>>>``](type-compose.html) + - [``DList<'T>``](type-dlist.html) + - [``Vector<'T,'Dimension>``](type-vector.html) + - [``Matrix<'T,'Rows,'Columns>``](type-matrix.html) + +Restricted: + - ``string`` + - ``StringBuilder`` + - ``Set<'T>`` + - ``IEnumerator<'T>`` + +Only for <*> operation: + - ``Map<'Key, 'T>`` + - ``Dictionary<'Key, 'T>`` + - ``IDictionary<'Key, 'T>`` + - ``IReadOnlyDictionary<'Key, 'T>`` + + + [Suggest another](https://github.com/fsprojects/FSharpPlus/issues/new) concrete implementation + +Examples +-------- +*) + + +(** +```f# +#r @"nuget: FSharpPlus" +``` +*) + +open FSharpPlus + +// Validations + +let validated = par2 { + let! x = async { return Ok 1 } + and! y = async { return Ok 2 } + and! z = async { return Error ["Error"] } + return x + y + z +} + +validated |> Async.RunSynchronously +// val it: Result = Error ["Error"] diff --git a/src/FSharpPlus/Builders.fs b/src/FSharpPlus/Builders.fs index ea391a3bc..cda39583c 100644 --- a/src/FSharpPlus/Builders.fs +++ b/src/FSharpPlus/Builders.fs @@ -220,6 +220,16 @@ module GenericBuilders = member inline _.MergeSources3 (t1: '``Applicative<'T>``, t2: '``Applicative<'U>``, t3: '``Applicative<'V>``) : '``Applicative<'T * 'U * 'V>`` = ParLift3.Invoke tuple3 t1 t2 t3 member _.Run f = f : '``Applicative<'T>`` + /// Generic 2 layers Parallel Applicative CE builder. + type ParallelBuilder2<'``applicative1>``> () = + member _.ReturnFrom expr : '``applicative1>`` = expr + member inline _.Return (x: 'T) : '``Applicative1>`` = (presult >> presult) x + member inline _.Yield (x: 'T) : '``Applicative1>`` = (presult >> presult) x + member inline _.BindReturn (x: '``Applicative1>``, []f: _ -> _) : '``Applicative1>`` = (map >> map) f x + member inline _.MergeSources (t1, t2) : '``Applicative1>`` = (plift2 >> plift2) tuple2 t1 t2 + member inline _.MergeSources3 (t1, t2, t3) : '``Applicative1>`` = (plift3 >> plift3) tuple3 t1 t2 t3 + member _.Run x : '``Applicative1>`` = x + /// Creates a (lazy) monadic computation expression with side-effects (see http://fsprojects.github.io/FSharpPlus/computation-expressions.html for more information) let monad<'``monad<'t>``> = new MonadFxBuilder<'``monad<'t>``> () @@ -238,4 +248,7 @@ module GenericBuilders = /// Creates a parallel applicative computation expression. let par<'``Applicative<'T>``> = ParallelBuilder<'``Applicative<'T>``> () + /// Creates a parallel applicative computation expression which compose effects of two Applicatives. + let par2<'``Applicative1>``> = ParallelBuilder2<'``Applicative1>``> () + #endif diff --git a/src/FSharpPlus/Operators.fs b/src/FSharpPlus/Operators.fs index 2ee924be7..6153c7fe4 100644 --- a/src/FSharpPlus/Operators.fs +++ b/src/FSharpPlus/Operators.fs @@ -176,14 +176,7 @@ module Operators = /// Apply a lifted argument to a lifted function: f <*> arg /// /// Applicative - let inline (<*>) (f: '``Applicative<'T -> 'U>``) (x: '``Applicative<'T>``) : '``Applicative<'U>`` = Apply.Invoke f x : '``Applicative<'U>`` - - /// - /// Apply a lifted argument to a lifted function: f </> arg. - /// Same as <*> but for parallel applicatives. - /// - /// Applicative - let inline () (f: '``Applicative<'T -> 'U>``) (x: '``Applicative<'T>``) : '``Applicative<'U>`` = ParApply.Invoke f x : '``Applicative<'U>`` + let inline (<*>) (f: '``Applicative<'T -> 'U>``) (x: '``Applicative<'T>``) : '``Applicative<'U>`` = Apply.Invoke f x : '``Applicative<'U>`` /// /// Applies 2 lifted arguments to a non-lifted function. Equivalent to map2 in non list-like types. @@ -226,6 +219,32 @@ module Operators = let inline opt (v: '``Alternative<'T>``) : '``Alternative>`` = (Some : 'T -> _) v result (None: option<'T>) + /// + /// Lifts a value into a Functor. Same as return in Computation Expressions. + /// + /// Applicative + let inline presult (x: 'T) : '``Functor<'T>`` = ParReturn.Invoke x + + /// + /// Apply a lifted argument to a lifted function: f </> arg. + /// Same as <*> but for parallel applicatives. + /// + /// Applicative + let inline () (f: '``Applicative<'T -> 'U>``) (x: '``Applicative<'T>``) : '``Applicative<'U>`` = ParApply.Invoke f x : '``Applicative<'U>`` + + /// + /// Applies 2 lifted arguments to a non-lifted function with parallel semantics. + /// + /// Applicative + let inline plift2 (f: 'T->'U->'V) (x: '``Applicative<'T>``) (y: '``Applicative<'U>``) : '``Applicative<'V>`` = ParLift2.Invoke f x y + + /// + /// Applies 3 lifted arguments to a non-lifted function with parallel semantics. + /// + /// Applicative + let inline plift3 (f: 'T->'U->'V->'W) (x: '``Applicative<'T>``) (y: '``Applicative<'U>``) (z: '``Applicative<'V>``) : '``Applicative<'W>`` = ParLift3.Invoke f x y z + + // Monad ----------------------------------------------------------- From be059d74431ed5465aabdf98411166b43acb5987 Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Wed, 10 Jan 2024 19:49:04 +0100 Subject: [PATCH 08/27] Make parX a subclass of X --- src/FSharpPlus/Control/Parallel.fs | 166 ++++++++--------------------- 1 file changed, 45 insertions(+), 121 deletions(-) diff --git a/src/FSharpPlus/Control/Parallel.fs b/src/FSharpPlus/Control/Parallel.fs index 8cf8b9b24..5d04043b8 100644 --- a/src/FSharpPlus/Control/Parallel.fs +++ b/src/FSharpPlus/Control/Parallel.fs @@ -4,7 +4,6 @@ open System open System.Runtime.InteropServices open System.Collections.Generic open System.Threading.Tasks -open Microsoft.FSharp.Quotations open FSharpPlus.Internals open FSharpPlus.Internals.Prelude @@ -13,88 +12,56 @@ open FSharpPlus.Data type ParReturn = - inherit Default1 + inherit Return static member inline InvokeOnInstance (x: 'T) = (^``ParApplicative<'T>`` : (static member ParReturn : ^T -> ^``ParApplicative<'T>``) x) #if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 static member inline Invoke (x: 'T) : '``ParApplicative<'T>`` = - let inline call (mthd: ^M, output: ^R) = ((^M or ^R) : (static member ParReturn : _*_ -> _) output, mthd) + let inline call (mthd: ^M, output: ^R) = ((^M or ^R) : (static member Return : _*_ -> _) output, mthd) call (Unchecked.defaultof, Unchecked.defaultof<'``ParApplicative<'T>``>) x - - - - static member ParReturn (_: seq<'a> , _: Default2) = fun x -> Seq.initInfinite (fun _ -> x) : seq<'a> - static member ParReturn (_: NonEmptySeq<'a>, _: Default2) = fun x -> NonEmptySeq.initInfinite (fun _ -> x) : NonEmptySeq<'a> - static member ParReturn (x: IEnumerator<'a>, y: Default2) = Return.Return (x, y) - static member inline ParReturn (_: 'R , _: Default1) = fun (x: 'T) -> ParReturn.InvokeOnInstance x : 'R - static member ParReturn (x: Lazy<'a> , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) + + static member Return (_: seq<'a> , _: Default2) = fun x -> Seq.initInfinite (fun _ -> x) : seq<'a> + static member Return (_: NonEmptySeq<'a>, _: Default2) = fun x -> NonEmptySeq.initInfinite (fun _ -> x) : NonEmptySeq<'a> + static member Return (x: IEnumerator<'a>, y: Default2) = Return.Return (x, y) + static member inline Return (_: 'R , _: Default1) = fun (x: 'T) -> Return.InvokeOnInstance x : 'R + static member Return (x: Lazy<'a> , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) #if !FABLE_COMPILER - static member ParReturn (_: 'T Task , _: ParReturn ) = fun x -> Task.FromResult x : 'T Task + static member Return (_: 'T Task , _: ParReturn) = fun x -> Task.FromResult x : 'T Task #endif #if NETSTANDARD2_1 && !FABLE_COMPILER - static member ParReturn (_: 'T ValueTask , _: ParReturn ) = fun (x: 'T) -> ValueTask<'T> x : 'T ValueTask + static member Return (_: 'T ValueTask , _: ParReturn) = fun (x: 'T) -> ValueTask<'T> x : 'T ValueTask #endif - static member inline ParReturn (x: option<'a> , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) - static member inline ParReturn (x: voption<'a> , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) - static member ParReturn (_: list<'a> , _: ParReturn ) = fun x -> List.cycle [x] : list<'a> - static member ParReturn (x: 'a [] , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) - static member ParReturn (x: 'r -> 'a , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) - static member inline ParReturn (x: 'm * 'a , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) - static member inline ParReturn (x: struct ('m * 'a), _: ParReturn ) = Return.Return (x, Unchecked.defaultof) - static member ParReturn (_: 'a Async , _: ParReturn ) = fun (x: 'a) -> async.Return x - static member inline ParReturn (_: Result<'t, 'e> , _: ParReturn ) = fun x -> if opaqueId false then Error (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e> : 'e) else Ok x : Result<'t,'e> - static member inline ParReturn (_: Choice<'t, 'e> , _: ParReturn ) = fun x -> if opaqueId false then Choice2Of2 (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e> : 'e) else Choice1Of2 x : Choice<'t,'e> - #if !FABLE_COMPILER - static member ParReturn (x: Expr<'a> , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) - #endif - static member ParReturn (x: ResizeArray<'a>, _: ParReturn ) = Return.Return (x, Unchecked.defaultof) + static member Return (_: list<'a> , _: ParReturn) = fun x -> List.cycle [x] : list<'a> + static member Return (_: 'a Async , _: ParReturn) = fun (x: 'a) -> async.Return x + static member inline Return (_: Result<'t, 'e> , _: ParReturn) = fun x -> if opaqueId false then Error (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e> : 'e) else Ok x : Result<'t,'e> + static member inline Return (_: Choice<'t, 'e> , _: ParReturn) = fun x -> if opaqueId false then Choice2Of2 (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e> : 'e) else Choice1Of2 x : Choice<'t,'e> #endif type ParApply = - inherit Default1 + inherit Apply #if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 - static member inline ```` (f: '``Monad<'T->'U>`` , x: '``Monad<'T>`` , []_output: '``Monad<'U>`` , []_mthd:Default2) : '``Monad<'U>`` = Bind.InvokeOnInstance f (fun (x1: 'T->'U) -> Bind.InvokeOnInstance x (fun x2 -> ParReturn.InvokeOnInstance (x1 x2))) - static member inline ```` (f: '``ParApplicative<'T->'U>``, x: '``ParApplicative<'T>``, []_output: '``ParApplicative<'U>``, []_mthd:Default1) : '``ParApplicative<'U>`` = ((^``ParApplicative<'T->'U>`` or ^``ParApplicative<'T>`` or ^``ParApplicative<'U>``) : (static member (<*>) : _*_ -> _) f, x) - - static member ```` (f: Lazy<'T->'U> , x: Lazy<'T> , []_output: Lazy<'U> , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - static member ```` (f: seq<_> , x: seq<'T> , []_output: seq<'U> , []_mthd: ParApply) = Seq.map2 (<|) f x : seq<'U> - static member ```` (f: NonEmptySeq<_> , x: NonEmptySeq<'T> , []_output: NonEmptySeq<'U> , []_mthd: ParApply) = NonEmptySeq.map2 (<|) f x : NonEmptySeq<'U> - static member ```` (f: IEnumerator<_> , x: IEnumerator<'T> , []_output: IEnumerator<'U> , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - static member ```` (f: list<_> , x: list<'T> , []_output: list<'U> , []_mthd: ParApply) = List.map2Shortest (<|) f x : list<'U> - static member ```` (f: _ [] , x: 'T [] , []_output: 'U [] , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - static member ```` (f: 'r -> _ , x: _ -> 'T , []_output: 'r -> 'U , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - static member inline ```` (f: 'Monoid * _ , x: ('Monoid * 'T) , []_output: 'Monoid * 'U , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - static member inline ```` (f: struct ('Monoid * _), x: struct ('Monoid * 'T), []_output: struct ('Monoid * 'U), []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ``<*>`` (struct (f: seq<_> , x: seq<'T> ), []_output: seq<'U> , []_mthd: ParApply) = Seq.map2 (<|) f x : seq<'U> + static member ``<*>`` (struct (f: NonEmptySeq<_> , x: NonEmptySeq<'T>), []_output: NonEmptySeq<'U> , []_mthd: ParApply) = NonEmptySeq.map2 (<|) f x : NonEmptySeq<'U> + static member ``<*>`` (struct (f: list<_> , x: list<'T> ), []_output: list<'U> , []_mthd: ParApply) = List.map2Shortest (<|) f x : list<'U> #if !FABLE_COMPILER - static member ```` (f: Task<_> , x: Task<'T> , []_output: Task<'U> , []_mthd: ParApply) = Task.apply f x : Task<'U> + static member ``<*>`` (struct (f: Task<_> , x: Task<'T> ), []_output: Task<'U> , []_mthd: ParApply) = Task.apply f x : Task<'U> #endif #if NETSTANDARD2_1 && !FABLE_COMPILER - static member ```` (f: ValueTask<_> , x: ValueTask<'T> , []_output: ValueTask<'U> , []_mthd: ParApply) = ValueTask.apply f x : ValueTask<'U> + static member ``<*>`` (struct (f: ValueTask<_> , x: ValueTask<'T> ), []_output: ValueTask<'U> , []_mthd: ParApply) = ValueTask.apply f x : ValueTask<'U> #endif - static member ```` (f: Async<_> , x: Async<'T> , []_output: Async<'U> , []_mthd: ParApply) = Async.pmap2 (<|) f x : Async<'U> - static member ```` (f: option<_> , x: option<'T> , []_output: option<'U> , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - static member ```` (f: voption<_> , x: voption<'T> , []_output: voption<'U> , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - static member inline ```` (f: Result<_,'E> , x: Result<'T,'E> , []_output: Result<'b,'E> , []_mthd: ParApply) = Result.apply2With Plus.Invoke (<|) f x : Result<'U, 'E> - static member inline ```` (f: Choice<_,'E> , x: Choice<'T,'E> , []_output: Choice<'b,'E> , []_mthd: ParApply) = Choice.apply2With Plus.Invoke (<|) f x : Choice<'U, 'E> - static member inline ```` (f: KeyValuePair<'Key,_>, x: KeyValuePair<'Key,'T>, []_output: KeyValuePair<'Key,'U>, []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - - static member ```` (f: Map<'Key,_> , x: Map<'Key,'T> , []_output: Map<'Key,'U> , []_mthd: ParApply) : Map<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - static member ```` (f: Dictionary<'Key,_>, x: Dictionary<'Key,'T> , []_output: Dictionary<'Key,'U> , []_mthd: ParApply) : Dictionary<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - static member ```` (f: IDictionary<'Key,_>, x: IDictionary<'Key,'T> , []_output: IDictionary<'Key,'U> , []_mthd: ParApply) : IDictionary<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - static member ```` (f: IReadOnlyDictionary<'Key,_>, x: IReadOnlyDictionary<'Key,'T> , []_output: IReadOnlyDictionary<'Key,'U> , []_mthd: ParApply) : IReadOnlyDictionary<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ``<*>`` (struct (f: Async<_> , x: Async<'T> ), []_output: Async<'U> , []_mthd: ParApply) = Async.pmap2 (<|) f x : Async<'U> + static member inline ``<*>`` (struct (f: Result<_,'E> , x: Result<'T,'E> ), []_output: Result<'b,'E> , []_mthd: ParApply) = Result.apply2With Plus.Invoke (<|) f x : Result<'U, 'E> + static member inline ``<*>`` (struct (f: Choice<_,'E> , x: Choice<'T,'E> ), []_output: Choice<'b,'E> , []_mthd: ParApply) = Choice.apply2With Plus.Invoke (<|) f x : Choice<'U, 'E> - #if !FABLE_COMPILER - static member ```` (f: Expr<'T->'U>, x: Expr<'T>, []_output: Expr<'U>, []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - #endif - static member ```` (f: ('T->'U) ResizeArray, x: 'T ResizeArray, []_output: 'U ResizeArray, []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ``<*>`` (struct (f: Tuple<_> , x: Tuple<'T> ), []_output: Tuple<'U> , []_mthd: ParApply) = Tuple<_>(f.Item1 x.Item1) : Tuple<'U> static member inline Invoke (f: '``ParApplicative<'T -> 'U>``) (x: '``ParApplicative<'T>``) : '``ParApplicative<'U>`` = let inline call (mthd : ^M, input1: ^I1, input2: ^I2, output: ^R) = - ((^M or ^I1 or ^I2 or ^R) : (static member ```` : _*_*_*_ -> _) input1, input2, output, mthd) + ((^M or ^I1 or ^I2 or ^R) : (static member ``<*>`` : struct (_*_) * _ * _ -> _) (struct (input1, input2)), output, mthd) call(Unchecked.defaultof, f, x, Unchecked.defaultof<'``ParApplicative<'U>``>) @@ -106,97 +73,54 @@ type ParApply = #if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 type ParLift2 = - inherit Default1 + inherit Lift2 - static member ParLift2 (f, (x: Lazy<_> , y: Lazy<_> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) - static member ParLift2 (f, (x: seq<_> , y: seq<_> ), _mthd: ParLift2) = Seq.map2 f x y - static member ParLift2 (f, (x: NonEmptySeq<_> , y: NonEmptySeq<_> ), _mthd: ParLift2) = NonEmptySeq.map2 f x y - static member ParLift2 (f, (x: IEnumerator<_> , y: IEnumerator<_> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) - static member ParLift2 (f, (x , y ), _mthd: ParLift2) = List.map2Shortest f x y - static member ParLift2 (f, (x: _ [] , y: _ [] ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) - static member ParLift2 (f, (x: 'R -> 'T , y: 'R -> 'U ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) - static member inline ParLift2 (f, (x: 'Monoid * 'T , y: 'Monoid * 'U ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) - static member inline ParLift2 (f, (x: struct ('Monoid * 'T), y: struct ('Monoid * 'U)), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member Lift2 (f, (x: seq<_> , y: seq<_> ), _mthd: ParLift2) = Seq.map2 f x y + static member Lift2 (f, (x: NonEmptySeq<_> , y: NonEmptySeq<_> ), _mthd: ParLift2) = NonEmptySeq.map2 f x y + static member Lift2 (f, (x , y ), _mthd: ParLift2) = List.map2Shortest f x y #if !FABLE_COMPILER - static member ParLift2 (f, (x: Task<'T> , y: Task<'U> ), _mthd: ParLift2) = Task.map2 f x y + static member Lift2 (f, (x: Task<'T> , y: Task<'U> ), _mthd: ParLift2) = Task.map2 f x y #endif #if NETSTANDARD2_1 && !FABLE_COMPILER - static member ParLift2 (f, (x: ValueTask<'T> , y: ValueTask<'U> ), _mthd: ParLift2) = ValueTask.map2 f x y - #endif - static member ParLift2 (f, (x , y ), _mthd: ParLift2) = Async.pmap2 f x y - static member ParLift2 (f, (x: option<_> , y: option<_> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) - - #if !FABLE_COMPILER - static member ParLift2 (f, (x: voption<_> , y: voption<_> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) - #endif - static member inline ParLift2 (f, (x: Result<'T,'Error> , y: Result<'U,'Error> ), _mthd: ParLift2) = Result.apply2With Plus.Invoke f x y - static member inline ParLift2 (f, (x: Choice<'T,'Error> , y: Choice<'U,'Error> ), _mthd: ParLift2) = Choice.map2 f x y - static member ParLift2 (f, (x: Map<'Key,'T> , y : Map<'Key,'U> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) - static member ParLift2 (f, (x: Dictionary<'Key,'T>, y: Dictionary<'Key,'U>), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) - #if !FABLE_COMPILER - static member ParLift2 (f, (x: Expr<'T> , y: Expr<'U> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member Lift2 (f, (x: ValueTask<'T> , y: ValueTask<'U> ), _mthd: ParLift2) = ValueTask.map2 f x y #endif - static member ParLift2 (f, (x: ResizeArray<'T> , y: ResizeArray<'U> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member Lift2 (f, (x , y ), _mthd: ParLift2) = Async.pmap2 f x y + static member inline Lift2 (f, (x: Result<'T,'Error> , y: Result<'U,'Error> ), _mthd: ParLift2) = Result.apply2With Plus.Invoke f x y + static member inline Lift2 (f, (x: Choice<'T,'Error> , y: Choice<'U,'Error> ), _mthd: ParLift2) = Choice.map2 f x y static member inline Invoke (f: 'T -> 'U -> 'V) (x: '``ParApplicative<'T>``) (y: '``ParApplicative<'U>``) : '``ParApplicative<'V>`` = let inline call (mthd : ^M, input1: ^I1, input2: ^I2, _output: ^R) = - ((^M or ^I1 or ^I2 or ^R) : (static member ParLift2 : _*(_*_)*_ -> _) f, (input1, input2), mthd) + ((^M or ^I1 or ^I2 or ^R) : (static member Lift2 : _*(_*_)*_ -> _) f, (input1, input2), mthd) call (Unchecked.defaultof, x, y, Unchecked.defaultof<'``ParApplicative<'V>``>) static member inline InvokeOnInstance (f: 'T -> 'U -> 'V) (x: '``ParApplicative<'T>``) (y: '``ParApplicative<'U>``) = ((^``ParApplicative<'T>`` or ^``ParApplicative<'U>``) : (static member ParLift2 : _*_*_ -> _) f, x, y) -type ParLift2 with - static member inline ParLift2 (f, (x, y), _mthd: Default2) = (((ParReturn.InvokeOnInstance f, x) ||> ParApply.InvokeOnInstance), y) ||> ParApply.InvokeOnInstance - - static member inline ParLift2 (_, (_:'t when 't: null and 't: struct, _: ^u when ^u : null and ^u: struct), _mthd: Default1) = id - static member inline ParLift2 (f: 'T -> 'U -> 'V, (x: '``ParApplicative<'T>``, y: '``ParApplicative<'U>``), _mthd: Default1) = ((^``ParApplicative<'T>`` or ^``ParApplicative<'U>`` ) : (static member ParLift2 : _*_*_ -> _) f, x, y) type ParLift3 = - inherit Default1 + inherit Lift3 - static member ParLift3 (f, (x: Lazy<_> , y: Lazy<_> , z: Lazy<_> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) - static member ParLift3 (f, (x: seq<_> , y: seq<_> , z: seq<_> ), _mthd: ParLift3) = Seq.map3 f x y z - static member ParLift3 (f, (x: NonEmptySeq<_> , y: NonEmptySeq<_> , z: NonEmptySeq<_> ), _mthd: ParLift3) = NonEmptySeq.map3 f x y z - static member ParLift3 (f, (x: IEnumerator<_> , y: IEnumerator<_> , z: IEnumerator<_> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) - static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = List.map3Shortest f x y z - static member ParLift3 (f, (x: _ [] , y: _ [] , z: _ [] ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) - static member ParLift3 (f, (x: 'R -> 'T , y: 'R -> 'U , z: 'R -> 'V ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) - static member inline ParLift3 (f, (x: 'Monoid * 'T , y: 'Monoid * 'U , z: 'Monoid * 'V ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) - static member inline ParLift3 (f, (x: struct ('Monoid * 'T), y: struct ('Monoid * 'U), z: struct ('Monoid * 'T)), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member Lift3 (f, (x: seq<_> , y: seq<_> , z: seq<_> ), _mthd: ParLift3) = Seq.map3 f x y z + static member Lift3 (f, (x: NonEmptySeq<_> , y: NonEmptySeq<_> , z: NonEmptySeq<_> ), _mthd: ParLift3) = NonEmptySeq.map3 f x y z + static member Lift3 (f, (x , y , z ), _mthd: ParLift3) = List.map3Shortest f x y z #if !FABLE_COMPILER - static member ParLift3 (f, (x: Task<'T> , y: Task<'U> , z: Task<'V> ), _mthd: ParLift3) = Task.map3 f x y z + static member Lift3 (f, (x: Task<'T> , y: Task<'U> , z: Task<'V> ), _mthd: ParLift3) = Task.map3 f x y z #endif #if NETSTANDARD2_1 && !FABLE_COMPILER - static member ParLift3 (f, (x: ValueTask<'T> , y: ValueTask<'U> , z: ValueTask<'V> ), _mthd: ParLift3) = ValueTask.map3 f x y z - #endif - static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = Async.pmap3 f x y z - static member ParLift3 (f, (x: option<_> , y: option<_> , z: option<_> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) - - #if !FABLE_COMPILER - static member ParLift3 (f, (x: voption<_> , y: voption<_> , z: voption<_> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) - #endif - static member inline ParLift3 (f, (x: Result<'T,'Error> , y: Result<'U,'Error> , z: Result<'V, 'Error> ), _mthd: ParLift3) = Result.apply3With Plus.Invoke f x y z - static member inline ParLift3 (f, (x: Choice<'T,'Error> , y: Choice<'U,'Error> , z: Choice<'V, 'Error> ), _mthd: ParLift3) = Choice.apply3With Plus.Invoke f x y z - static member ParLift3 (f, (x: Map<'Key,'T> , y: Map<'Key,'U> , z: Map<'Key, 'V> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) - static member ParLift3 (f, (x: Dictionary<'Key,'T>, y: Dictionary<'Key,'U>, z: Dictionary<'Key, 'V>), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) - #if !FABLE_COMPILER - static member ParLift3 (f, (x: Expr<'T> , y: Expr<'U> , z: Expr<'V> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member Lift3 (f, (x: ValueTask<'T> , y: ValueTask<'U> , z: ValueTask<'V> ), _mthd: ParLift3) = ValueTask.map3 f x y z #endif - static member ParLift3 (f, (x: ResizeArray<'T> , y: ResizeArray<'U> , z: ResizeArray<'V> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member Lift3 (f, (x , y , z ), _mthd: ParLift3) = Async.pmap3 f x y z + static member inline Lift3 (f, (x: Result<'T,'Error> , y: Result<'U,'Error> , z: Result<'V, 'Error> ), _mthd: ParLift3) = Result.apply3With Plus.Invoke f x y z + static member inline Lift3 (f, (x: Choice<'T,'Error> , y: Choice<'U,'Error> , z: Choice<'V, 'Error> ), _mthd: ParLift3) = Choice.apply3With Plus.Invoke f x y z static member inline Invoke (f: 'T -> 'U -> 'V -> 'W) (x: '``ParApplicative<'T>``) (y: '``ParApplicative<'U>``) (z: '``ParApplicative<'V>``): '``ParApplicative<'W>`` = let inline call (mthd : ^M, input1: ^I1, input2: ^I2, input3: ^I3, _output: ^R) = - ((^M or ^I1 or ^I2 or ^I3 or ^R) : (static member ParLift3 : _*(_*_*_)*_ -> _) f, (input1, input2, input3), mthd) + ((^M or ^I1 or ^I2 or ^I3 or ^R) : (static member Lift3 : _*(_*_*_)*_ -> _) f, (input1, input2, input3), mthd) call (Unchecked.defaultof, x, y, z, Unchecked.defaultof<'``ParApplicative<'W>``>) static member inline InvokeOnInstance (f: 'T -> 'U -> 'V -> 'W) (x: '``ParApplicative<'T>``) (y: '``ParApplicative<'U>``) (z: '``ParApplicative<'V>``)= ((^``ParApplicative<'T>`` or ^``ParApplicative<'U>`` or ^``ParApplicative<'V>``) : (static member ParLift3 : _*_*_*_ -> _) f, x, y, z) -type ParLift3 with - static member inline ParLift3 (f, (x, y, z), _mthd: Default3) = ((((ParReturn.InvokeOnInstance f, x) ||> ParApply.InvokeOnInstance), y) ||> ParApply.InvokeOnInstance, z) ||> ParApply.InvokeOnInstance - static member inline ParLift3 (_, (_:'t when 't: null and 't: struct, _: ^u when ^u : null and ^u: struct, _: ^v when ^v : null and ^v: struct), _mthd: Default1) = id - static member inline ParLift3 (f: 'T -> 'U -> 'V -> 'W, (x: '``ParApplicative<'T>``, y: '``ParApplicative<'U>``, z: '``ParApplicative<'V>``) , _mthd: Default1) = ((^``ParApplicative<'T>`` or ^``ParApplicative<'U>`` or ^``ParApplicative<'V>`` ) : (static member ParLift3 : _*_*_*_ -> _) f, x, y, z) type IsParLeftZero = inherit Default1 From 3775257905383800d578f1c9b1acd1e400b6e33f Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Sat, 13 Jan 2024 09:48:00 +0100 Subject: [PATCH 09/27] Revert defaulting to Applicative --- src/FSharpPlus/Control/Parallel.fs | 191 ++++++++++++++++++++--------- 1 file changed, 135 insertions(+), 56 deletions(-) diff --git a/src/FSharpPlus/Control/Parallel.fs b/src/FSharpPlus/Control/Parallel.fs index 5d04043b8..c8cf35c46 100644 --- a/src/FSharpPlus/Control/Parallel.fs +++ b/src/FSharpPlus/Control/Parallel.fs @@ -4,6 +4,7 @@ open System open System.Runtime.InteropServices open System.Collections.Generic open System.Threading.Tasks +open Microsoft.FSharp.Quotations open FSharpPlus.Internals open FSharpPlus.Internals.Prelude @@ -12,115 +13,193 @@ open FSharpPlus.Data type ParReturn = - inherit Return + inherit Default1 static member inline InvokeOnInstance (x: 'T) = (^``ParApplicative<'T>`` : (static member ParReturn : ^T -> ^``ParApplicative<'T>``) x) #if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 static member inline Invoke (x: 'T) : '``ParApplicative<'T>`` = - let inline call (mthd: ^M, output: ^R) = ((^M or ^R) : (static member Return : _*_ -> _) output, mthd) + let inline call (mthd: ^M, output: ^R) = ((^M or ^R) : (static member ParReturn : _*_ -> _) output, mthd) call (Unchecked.defaultof, Unchecked.defaultof<'``ParApplicative<'T>``>) x - - static member Return (_: seq<'a> , _: Default2) = fun x -> Seq.initInfinite (fun _ -> x) : seq<'a> - static member Return (_: NonEmptySeq<'a>, _: Default2) = fun x -> NonEmptySeq.initInfinite (fun _ -> x) : NonEmptySeq<'a> - static member Return (x: IEnumerator<'a>, y: Default2) = Return.Return (x, y) - static member inline Return (_: 'R , _: Default1) = fun (x: 'T) -> Return.InvokeOnInstance x : 'R - static member Return (x: Lazy<'a> , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) + + + + static member ParReturn (_: seq<'a> , _: Default2) = fun x -> Seq.initInfinite (fun _ -> x) : seq<'a> + static member ParReturn (_: NonEmptySeq<'a>, _: Default2) = fun x -> NonEmptySeq.initInfinite (fun _ -> x) : NonEmptySeq<'a> + static member ParReturn (x: IEnumerator<'a>, y: Default2) = Return.Return (x, y) + static member inline ParReturn (_: 'R , _: Default1) = fun (x: 'T) -> ParReturn.InvokeOnInstance x : 'R + static member ParReturn (x: Lazy<'a> , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) #if !FABLE_COMPILER - static member Return (_: 'T Task , _: ParReturn) = fun x -> Task.FromResult x : 'T Task + static member ParReturn (_: 'T Task , _: ParReturn ) = fun x -> Task.FromResult x : 'T Task #endif #if NETSTANDARD2_1 && !FABLE_COMPILER - static member Return (_: 'T ValueTask , _: ParReturn) = fun (x: 'T) -> ValueTask<'T> x : 'T ValueTask + static member ParReturn (_: 'T ValueTask , _: ParReturn ) = fun (x: 'T) -> ValueTask<'T> x : 'T ValueTask + #endif + static member inline ParReturn (x: option<'a> , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) + static member inline ParReturn (x: voption<'a> , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) + static member ParReturn (_: list<'a> , _: ParReturn ) = fun x -> List.cycle [x] : list<'a> + // static member ParReturn (x: 'a [] , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) + static member ParReturn (x: 'r -> 'a , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) + static member inline ParReturn (x: 'm * 'a , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) + static member inline ParReturn (x: struct ('m * 'a), _: ParReturn ) = Return.Return (x, Unchecked.defaultof) + static member ParReturn (_: 'a Async , _: ParReturn ) = fun (x: 'a) -> async.Return x + static member inline ParReturn (_: Result<'t, 'e> , _: ParReturn ) = fun x -> if opaqueId false then Error (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e> : 'e) else Ok x : Result<'t,'e> + static member inline ParReturn (_: Choice<'t, 'e> , _: ParReturn ) = fun x -> if opaqueId false then Choice2Of2 (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e> : 'e) else Choice1Of2 x : Choice<'t,'e> + #if !FABLE_COMPILER + static member ParReturn (x: Expr<'a> , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) #endif - static member Return (_: list<'a> , _: ParReturn) = fun x -> List.cycle [x] : list<'a> - static member Return (_: 'a Async , _: ParReturn) = fun (x: 'a) -> async.Return x - static member inline Return (_: Result<'t, 'e> , _: ParReturn) = fun x -> if opaqueId false then Error (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e> : 'e) else Ok x : Result<'t,'e> - static member inline Return (_: Choice<'t, 'e> , _: ParReturn) = fun x -> if opaqueId false then Choice2Of2 (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e> : 'e) else Choice1Of2 x : Choice<'t,'e> + // static member ParReturn (x: ResizeArray<'a>, _: ParReturn ) = Return.Return (x, Unchecked.defaultof) #endif type ParApply = - inherit Apply + inherit Default1 #if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 - - static member ``<*>`` (struct (f: seq<_> , x: seq<'T> ), []_output: seq<'U> , []_mthd: ParApply) = Seq.map2 (<|) f x : seq<'U> - static member ``<*>`` (struct (f: NonEmptySeq<_> , x: NonEmptySeq<'T>), []_output: NonEmptySeq<'U> , []_mthd: ParApply) = NonEmptySeq.map2 (<|) f x : NonEmptySeq<'U> - static member ``<*>`` (struct (f: list<_> , x: list<'T> ), []_output: list<'U> , []_mthd: ParApply) = List.map2Shortest (<|) f x : list<'U> + // static member inline ```` (struct (f: '``ParApplicative<'T->'U>``, x: '``ParApplicative<'T>``), []_output: '``ParApplicative<'U>``, []_mthd:Default1) : '``ParApplicative<'U>`` = ((^``ParApplicative<'T->'U>`` or ^``ParApplicative<'T>`` or ^``ParApplicative<'U>``) : (static member () : _*_ -> _) f, x) + static member ```` (struct (f: Lazy<'T->'U> , x: Lazy<'T> ), []_output: Lazy<'U> , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ```` (struct (f: seq<_> , x: seq<'T> ), []_output: seq<'U> , []_mthd: ParApply) = Seq.map2 (<|) f x + static member ```` (struct (f: NonEmptySeq<_> , x: NonEmptySeq<'T> ), []_output: NonEmptySeq<'U> , []_mthd: ParApply) = NonEmptySeq.map2 (<|) f x + static member ```` (struct (f: IEnumerator<_> , x: IEnumerator<'T> ), []_output: IEnumerator<'U> , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ```` (struct (f: list<_> , x: list<'T> ), []_output: list<'U> , []_mthd: ParApply) = List.map2Shortest (<|) f x + static member ```` (struct (f: _ [] , x: 'T [] ), []_output: 'U [] , []_mthd: ParApply) = Array.map2Shortest (<|) f x + static member ```` (struct (f: 'r -> _ , x: _ -> 'T ), []_output: 'r -> 'U , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member inline ```` (struct (f: 'Monoid * _ , x: ('Monoid * 'T) ), []_output: 'Monoid * 'U , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member inline ```` (struct (f: struct ('Monoid * _), x: struct ('Monoid * 'T)), []_output: struct ('Monoid * 'U), []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) #if !FABLE_COMPILER - static member ``<*>`` (struct (f: Task<_> , x: Task<'T> ), []_output: Task<'U> , []_mthd: ParApply) = Task.apply f x : Task<'U> + static member ```` (struct (f: Task<_> , x: Task<'T> ), []_output: Task<'U> , []_mthd: ParApply) = Task.pmap2 (<|) f x #endif - #if NETSTANDARD2_1 && !FABLE_COMPILER - static member ``<*>`` (struct (f: ValueTask<_> , x: ValueTask<'T> ), []_output: ValueTask<'U> , []_mthd: ParApply) = ValueTask.apply f x : ValueTask<'U> + #if !NET45 && !NETSTANDARD2_0 && !FABLE_COMPILER + static member ```` (struct (f: ValueTask<_> , x: ValueTask<'T> ), []_output: ValueTask<'U> , []_mthd: ParApply) = ValueTask.pmap2 (<|) f x #endif - static member ``<*>`` (struct (f: Async<_> , x: Async<'T> ), []_output: Async<'U> , []_mthd: ParApply) = Async.pmap2 (<|) f x : Async<'U> - static member inline ``<*>`` (struct (f: Result<_,'E> , x: Result<'T,'E> ), []_output: Result<'b,'E> , []_mthd: ParApply) = Result.apply2With Plus.Invoke (<|) f x : Result<'U, 'E> - static member inline ``<*>`` (struct (f: Choice<_,'E> , x: Choice<'T,'E> ), []_output: Choice<'b,'E> , []_mthd: ParApply) = Choice.apply2With Plus.Invoke (<|) f x : Choice<'U, 'E> + static member ```` (struct (f: Async<_> , x: Async<'T> ), []_output: Async<'U> , []_mthd: ParApply) : Async<'U> = Async.pmap2 (<|) f x + static member ```` (struct (f: option<_> , x: option<'T> ), []_output: option<'U> , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ```` (struct (f: voption<_> , x: voption<'T> ), []_output: voption<'U> , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member inline ```` (struct (f: Result<_,'E> , x: Result<'T,'E> ), []_output: Result<'b,'E> , []_mthd: ParApply) : Result<'U, 'E> = Result.apply2With Plus.Invoke (<|) f x + static member inline ```` (struct (f: Choice<_,'E> , x: Choice<'T,'E> ), []_output: Choice<'b,'E> , []_mthd: ParApply) : Choice<'U, 'E> = Choice.apply2With Plus.Invoke (<|) f x + static member inline ```` (struct (f: KeyValuePair<'Key,_>, x: KeyValuePair<'Key,'T>), []_output: KeyValuePair<'Key,'U>, []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + + static member ```` (struct (f: Map<'Key,_> , x: Map<'Key,'T> ), []_output: Map<'Key,'U> , []_mthd: ParApply) : Map<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ```` (struct (f: Dictionary<'Key,_> , x: Dictionary<'Key,'T> ), []_output: Dictionary<'Key,'U> , []_mthd: ParApply) : Dictionary<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ```` (struct (f: IDictionary<'Key,_> , x: IDictionary<'Key,'T> ), []_output: IDictionary<'Key,'U> , []_mthd: ParApply) : IDictionary<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ```` (struct (f: IReadOnlyDictionary<'Key,_>, x: IReadOnlyDictionary<'Key,'T> ), []_output: IReadOnlyDictionary<'Key,'U>, []_mthd: ParApply) : IReadOnlyDictionary<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - static member ``<*>`` (struct (f: Tuple<_> , x: Tuple<'T> ), []_output: Tuple<'U> , []_mthd: ParApply) = Tuple<_>(f.Item1 x.Item1) : Tuple<'U> + #if !FABLE_COMPILER + static member ```` (struct (f: Expr<'T->'U>, x: Expr<'T>), []_output: Expr<'U>, []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + #endif + static member ```` (struct (f: ('T->'U) ResizeArray, x: 'T ResizeArray), []_output: 'U ResizeArray, []_mthd: ParApply) = ResizeArray.map2Shortest (<|) f x static member inline Invoke (f: '``ParApplicative<'T -> 'U>``) (x: '``ParApplicative<'T>``) : '``ParApplicative<'U>`` = - let inline call (mthd : ^M, input1: ^I1, input2: ^I2, output: ^R) = - ((^M or ^I1 or ^I2 or ^R) : (static member ``<*>`` : struct (_*_) * _ * _ -> _) (struct (input1, input2)), output, mthd) + let inline call (mthd: ^M, input1: ^I1, input2: ^I2, output: ^R) = + ((^M or ^I1 or ^I2 or ^R) : (static member ```` : struct (_*_) * _ * _ -> _) (struct (input1, input2)), output, mthd) call(Unchecked.defaultof, f, x, Unchecked.defaultof<'``ParApplicative<'U>``>) - #endif static member inline InvokeOnInstance (f: '``ParApplicative<'T->'U>``) (x: '``ParApplicative<'T>``) : '``ParApplicative<'U>`` = - ((^``ParApplicative<'T->'U>`` or ^``ParApplicative<'T>`` or ^``ParApplicative<'U>``) : (static member (<*>) : _*_ -> _) (f, x)) + ((^``ParApplicative<'T->'U>`` or ^``ParApplicative<'T>`` or ^``ParApplicative<'U>``) : (static member () : _*_ -> _) (f, x)) #if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 +type ParApply with + // static member inline ```` (struct (f: '``Monad<'T->'U>`` , x: '``Monad<'T>`` ) , _output: '``Monad<'U>`` , []_mthd:Default2) : '``Monad<'U>`` = Bind.InvokeOnInstance f (fun (x1: 'T->'U) -> Bind.InvokeOnInstance x (fun x2 -> Return.InvokeOnInstance (x1 x2))) + static member inline ```` (struct (_: ^t when ^t : null and ^t: struct, _: ^u when ^u : null and ^u: struct), _output: ^r when ^r : null and ^r: struct, _mthd: Default1) = id + + static member inline ```` (struct (f: '``Applicative<'T->'U>``, x: '``Applicative<'T>``), _output: '``Applicative<'U>``, []_mthd: Default1) : '``Applicative<'U>`` = ((^``Applicative<'T->'U>`` or ^``Applicative<'T>`` or ^``Applicative<'U>``) : (static member () : _*_ -> _) f, x) + + type ParLift2 = - inherit Lift2 + inherit Default1 - static member Lift2 (f, (x: seq<_> , y: seq<_> ), _mthd: ParLift2) = Seq.map2 f x y - static member Lift2 (f, (x: NonEmptySeq<_> , y: NonEmptySeq<_> ), _mthd: ParLift2) = NonEmptySeq.map2 f x y - static member Lift2 (f, (x , y ), _mthd: ParLift2) = List.map2Shortest f x y + static member ParLift2 (f, (x: Lazy<_> , y: Lazy<_> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member ParLift2 (f, (x: seq<_> , y: seq<_> ), _mthd: ParLift2) = Seq.map2 f x y + static member ParLift2 (f, (x: NonEmptySeq<_> , y: NonEmptySeq<_> ), _mthd: ParLift2) = NonEmptySeq.map2 f x y + static member ParLift2 (f, (x: IEnumerator<_> , y: IEnumerator<_> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member ParLift2 (f, (x , y ), _mthd: ParLift2) = List.map2Shortest f x y + static member ParLift2 (f, (x: _ [] , y: _ [] ), _mthd: ParLift2) = Array.map2Shortest f x y + static member ParLift2 (f, (x: 'R -> 'T , y: 'R -> 'U ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member inline ParLift2 (f, (x: 'Monoid * 'T , y: 'Monoid * 'U ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member inline ParLift2 (f, (x: struct ('Monoid * 'T), y: struct ('Monoid * 'U)), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) #if !FABLE_COMPILER - static member Lift2 (f, (x: Task<'T> , y: Task<'U> ), _mthd: ParLift2) = Task.map2 f x y + static member ParLift2 (f, (x: Task<'T> , y: Task<'U> ), _mthd: ParLift2) = Task.pmap2 f x y #endif #if NETSTANDARD2_1 && !FABLE_COMPILER - static member Lift2 (f, (x: ValueTask<'T> , y: ValueTask<'U> ), _mthd: ParLift2) = ValueTask.map2 f x y + static member ParLift2 (f, (x: ValueTask<'T> , y: ValueTask<'U> ), _mthd: ParLift2) = ValueTask.pmap2 f x y + #endif + static member ParLift2 (f, (x , y ), _mthd: ParLift2) = Async.pmap2 f x y + static member ParLift2 (f, (x: option<_> , y: option<_> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + + #if !FABLE_COMPILER + static member ParLift2 (f, (x: voption<_> , y: voption<_> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) #endif - static member Lift2 (f, (x , y ), _mthd: ParLift2) = Async.pmap2 f x y - static member inline Lift2 (f, (x: Result<'T,'Error> , y: Result<'U,'Error> ), _mthd: ParLift2) = Result.apply2With Plus.Invoke f x y - static member inline Lift2 (f, (x: Choice<'T,'Error> , y: Choice<'U,'Error> ), _mthd: ParLift2) = Choice.map2 f x y + static member inline ParLift2 (f, (x: Result<'T,'Error> , y: Result<'U,'Error> ), _mthd: ParLift2) = Result.apply2With Plus.Invoke f x y + static member inline ParLift2 (f, (x: Choice<'T,'Error> , y: Choice<'U,'Error> ), _mthd: ParLift2) = Choice.map2 f x y + static member ParLift2 (f, (x: Map<'Key,'T> , y : Map<'Key,'U> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member ParLift2 (f, (x: Dictionary<'Key,'T>, y: Dictionary<'Key,'U>), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + #if !FABLE_COMPILER + static member ParLift2 (f, (x: Expr<'T> , y: Expr<'U> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + #endif + static member ParLift2 (f, (x: ResizeArray<'T> , y: ResizeArray<'U> ), _mthd: ParLift2) = ResizeArray.map2Shortest f x y static member inline Invoke (f: 'T -> 'U -> 'V) (x: '``ParApplicative<'T>``) (y: '``ParApplicative<'U>``) : '``ParApplicative<'V>`` = let inline call (mthd : ^M, input1: ^I1, input2: ^I2, _output: ^R) = - ((^M or ^I1 or ^I2 or ^R) : (static member Lift2 : _*(_*_)*_ -> _) f, (input1, input2), mthd) + ((^M or ^I1 or ^I2 or ^R) : (static member ParLift2 : _*(_*_)*_ -> _) f, (input1, input2), mthd) call (Unchecked.defaultof, x, y, Unchecked.defaultof<'``ParApplicative<'V>``>) static member inline InvokeOnInstance (f: 'T -> 'U -> 'V) (x: '``ParApplicative<'T>``) (y: '``ParApplicative<'U>``) = ((^``ParApplicative<'T>`` or ^``ParApplicative<'U>``) : (static member ParLift2 : _*_*_ -> _) f, x, y) +type ParLift2 with + static member inline ParLift2 (f, (x, y), _mthd: Default2) = (((ParReturn.InvokeOnInstance f, x) ||> ParApply.InvokeOnInstance), y) ||> ParApply.InvokeOnInstance + + static member inline ParLift2 (_, (_:'t when 't: null and 't: struct, _: ^u when ^u : null and ^u: struct), _mthd: Default1) = id + static member inline ParLift2 (f: 'T -> 'U -> 'V, (x: '``ParApplicative<'T>``, y: '``ParApplicative<'U>``), _mthd: Default1) = ((^``ParApplicative<'T>`` or ^``ParApplicative<'U>`` ) : (static member ParLift2 : _*_*_ -> _) f, x, y) type ParLift3 = - inherit Lift3 + inherit Default1 - static member Lift3 (f, (x: seq<_> , y: seq<_> , z: seq<_> ), _mthd: ParLift3) = Seq.map3 f x y z - static member Lift3 (f, (x: NonEmptySeq<_> , y: NonEmptySeq<_> , z: NonEmptySeq<_> ), _mthd: ParLift3) = NonEmptySeq.map3 f x y z - static member Lift3 (f, (x , y , z ), _mthd: ParLift3) = List.map3Shortest f x y z + static member ParLift3 (f, (x: Lazy<_> , y: Lazy<_> , z: Lazy<_> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member ParLift3 (f, (x: seq<_> , y: seq<_> , z: seq<_> ), _mthd: ParLift3) = Seq.map3 f x y z + static member ParLift3 (f, (x: NonEmptySeq<_> , y: NonEmptySeq<_> , z: NonEmptySeq<_> ), _mthd: ParLift3) = NonEmptySeq.map3 f x y z + static member ParLift3 (f, (x: IEnumerator<_> , y: IEnumerator<_> , z: IEnumerator<_> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = List.map3Shortest f x y z + static member ParLift3 (f, (x: _ [] , y: _ [] , z: _ [] ), _mthd: ParLift3) = Array.map3Shortest f x y z + static member ParLift3 (f, (x: 'R -> 'T , y: 'R -> 'U , z: 'R -> 'V ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member inline ParLift3 (f, (x: 'Monoid * 'T , y: 'Monoid * 'U , z: 'Monoid * 'V ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member inline ParLift3 (f, (x: struct ('Monoid * 'T), y: struct ('Monoid * 'U), z: struct ('Monoid * 'T)), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) #if !FABLE_COMPILER - static member Lift3 (f, (x: Task<'T> , y: Task<'U> , z: Task<'V> ), _mthd: ParLift3) = Task.map3 f x y z + static member ParLift3 (f, (x: Task<'T> , y: Task<'U> , z: Task<'V> ), _mthd: ParLift3) = Task.pmap3 f x y z #endif #if NETSTANDARD2_1 && !FABLE_COMPILER - static member Lift3 (f, (x: ValueTask<'T> , y: ValueTask<'U> , z: ValueTask<'V> ), _mthd: ParLift3) = ValueTask.map3 f x y z + static member ParLift3 (f, (x: ValueTask<'T> , y: ValueTask<'U> , z: ValueTask<'V> ), _mthd: ParLift3) = ValueTask.pmap3 f x y z + #endif + static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = Async.pmap3 f x y z + static member ParLift3 (f, (x: option<_> , y: option<_> , z: option<_> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + + #if !FABLE_COMPILER + static member ParLift3 (f, (x: voption<_> , y: voption<_> , z: voption<_> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + #endif + static member inline ParLift3 (f, (x: Result<'T,'Error> , y: Result<'U,'Error> , z: Result<'V, 'Error> ), _mthd: ParLift3) = Result.apply3With Plus.Invoke f x y z + static member inline ParLift3 (f, (x: Choice<'T,'Error> , y: Choice<'U,'Error> , z: Choice<'V, 'Error> ), _mthd: ParLift3) = Choice.apply3With Plus.Invoke f x y z + static member ParLift3 (f, (x: Map<'Key,'T> , y: Map<'Key,'U> , z: Map<'Key, 'V> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member ParLift3 (f, (x: Dictionary<'Key,'T>, y: Dictionary<'Key,'U>, z: Dictionary<'Key, 'V>), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + #if !FABLE_COMPILER + static member ParLift3 (f, (x: Expr<'T> , y: Expr<'U> , z: Expr<'V> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) #endif - static member Lift3 (f, (x , y , z ), _mthd: ParLift3) = Async.pmap3 f x y z - static member inline Lift3 (f, (x: Result<'T,'Error> , y: Result<'U,'Error> , z: Result<'V, 'Error> ), _mthd: ParLift3) = Result.apply3With Plus.Invoke f x y z - static member inline Lift3 (f, (x: Choice<'T,'Error> , y: Choice<'U,'Error> , z: Choice<'V, 'Error> ), _mthd: ParLift3) = Choice.apply3With Plus.Invoke f x y z + static member ParLift3 (f, (x: ResizeArray<'T> , y: ResizeArray<'U> , z: ResizeArray<'V> ), _mthd: ParLift3) = ResizeArray.map3Shortest f x y z - static member inline Invoke (f: 'T -> 'U -> 'V -> 'W) (x: '``ParApplicative<'T>``) (y: '``ParApplicative<'U>``) (z: '``ParApplicative<'V>``): '``ParApplicative<'W>`` = - let inline call (mthd : ^M, input1: ^I1, input2: ^I2, input3: ^I3, _output: ^R) = - ((^M or ^I1 or ^I2 or ^I3 or ^R) : (static member Lift3 : _*(_*_*_)*_ -> _) f, (input1, input2, input3), mthd) + static member inline Invoke (f: 'T -> 'U -> 'V -> 'W) (x: '``ParApplicative<'T>``) (y: '``ParApplicative<'U>``) (z: '``ParApplicative<'V>``) : '``ParApplicative<'W>`` = + let inline call (mthd: ^M, input1: ^I1, input2: ^I2, input3: ^I3, _output: ^R) = + ((^M or ^I1 or ^I2 or ^I3 or ^R) : (static member ParLift3 : _*(_*_*_)*_ -> _) f, (input1, input2, input3), mthd) call (Unchecked.defaultof, x, y, z, Unchecked.defaultof<'``ParApplicative<'W>``>) static member inline InvokeOnInstance (f: 'T -> 'U -> 'V -> 'W) (x: '``ParApplicative<'T>``) (y: '``ParApplicative<'U>``) (z: '``ParApplicative<'V>``)= ((^``ParApplicative<'T>`` or ^``ParApplicative<'U>`` or ^``ParApplicative<'V>``) : (static member ParLift3 : _*_*_*_ -> _) f, x, y, z) +type ParLift3 with + static member inline ParLift3 (f, (x, y, z), _mthd: Default3) = ((((ParReturn.InvokeOnInstance f, x) ||> ParApply.InvokeOnInstance), y) ||> ParApply.InvokeOnInstance, z) ||> ParApply.InvokeOnInstance + static member inline ParLift3 (_, (_:'t when 't: null and 't: struct, _: ^u when ^u : null and ^u: struct, _: ^v when ^v : null and ^v: struct), _mthd: Default1) = id + static member inline ParLift3 (f: 'T -> 'U -> 'V -> 'W, (x: '``ParApplicative<'T>``, y: '``ParApplicative<'U>``, z: '``ParApplicative<'V>``) , _mthd: Default1) = ((^``ParApplicative<'T>`` or ^``ParApplicative<'U>`` or ^``ParApplicative<'V>`` ) : (static member ParLift3 : _*_*_*_ -> _) f, x, y, z) type IsParLeftZero = inherit Default1 @@ -128,7 +207,7 @@ type IsParLeftZero = static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = Seq.isEmpty t.Value static member IsParLeftZero (_: ref>, _mthd: IsParLeftZero) = false static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = List.isEmpty t.Value - static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = IsLeftZero.IsLeftZero (t, Unchecked.defaultof) + static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = Array.isEmpty t.Value static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = IsLeftZero.IsLeftZero (t, Unchecked.defaultof) #if !FABLE_COMPILER static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = IsLeftZero.IsLeftZero (t, Unchecked.defaultof) @@ -137,7 +216,7 @@ type IsParLeftZero = static member IsParLeftZero (_: ref> , _mthd: IsParLeftZero) = false static member inline Invoke (x: '``ParApplicative<'T>``) : bool = - let inline call (mthd : ^M, input: ^I) = + let inline call (mthd: ^M, input: ^I) = ((^M or ^I) : (static member IsParLeftZero : _*_ -> _) ref input, mthd) call(Unchecked.defaultof, x) @@ -150,9 +229,9 @@ type IsParLeftZero with static member inline IsParLeftZero (_: ref<'T> when 'T : not struct, _mthd: Default3) = false // empty f = empty ==> empty is left zero for - static member inline IsParLeftZero (t: ref<'``Alternative<'T>``> , _mthd: Default2) = (t.Value = Empty.InvokeOnInstance ()) + static member inline IsParLeftZero (t: ref<'``Alternative<'T>``> , _mthd: Default2) = (t.Value = Empty.InvokeOnInstance ()) - static member inline IsParLeftZero (t: ref<'``ParApplicative<'T>``> , _mthd: Default1) = (^``ParApplicative<'T>`` : (static member IsParLeftZero : _ -> _) t.Value) + static member inline IsParLeftZero (t: ref<'``ParApplicative<'T>``> , _mthd: Default1) = (^``ParApplicative<'T>`` : (static member IsParLeftZero : _ -> _) t.Value) static member inline IsParLeftZero (_: ref< ^t> when ^t: null and ^t: struct, _: Default1) = () #endif \ No newline at end of file From 822779324ba922a97de114751981b5622f63c666 Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Sat, 13 Jan 2024 10:49:32 +0100 Subject: [PATCH 10/27] Fable --- src/FSharpPlus/Control/Parallel.fs | 43 +++++++++++++++++------------- 1 file changed, 24 insertions(+), 19 deletions(-) diff --git a/src/FSharpPlus/Control/Parallel.fs b/src/FSharpPlus/Control/Parallel.fs index c8cf35c46..b44c69767 100644 --- a/src/FSharpPlus/Control/Parallel.fs +++ b/src/FSharpPlus/Control/Parallel.fs @@ -24,31 +24,36 @@ type ParReturn = - static member ParReturn (_: seq<'a> , _: Default2) = fun x -> Seq.initInfinite (fun _ -> x) : seq<'a> - static member ParReturn (_: NonEmptySeq<'a>, _: Default2) = fun x -> NonEmptySeq.initInfinite (fun _ -> x) : NonEmptySeq<'a> - static member ParReturn (x: IEnumerator<'a>, y: Default2) = Return.Return (x, y) - static member inline ParReturn (_: 'R , _: Default1) = fun (x: 'T) -> ParReturn.InvokeOnInstance x : 'R - static member ParReturn (x: Lazy<'a> , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) + static member ParReturn (_: seq<'a> , _: Default2 ) = fun x -> Seq.initInfinite (fun _ -> x) : seq<'a> + static member ParReturn (_: NonEmptySeq<'a> , _: Default2 ) = fun x -> NonEmptySeq.initInfinite (fun _ -> x) : NonEmptySeq<'a> + static member ParReturn (_: IEnumerator<'a> , _: Default2 ) = Enumerator.unfold (fun x -> Some (x, x)) : _ -> IEnumerator<'a> + static member inline ParReturn (_: 'R , _: Default1 ) = fun (x: 'T) -> ParReturn.InvokeOnInstance x : 'R + static member ParReturn (x: Lazy<'a> , _: ParReturn) = Return.Return (x, Unchecked.defaultof) : _ -> Lazy<'a> #if !FABLE_COMPILER - static member ParReturn (_: 'T Task , _: ParReturn ) = fun x -> Task.FromResult x : 'T Task + static member ParReturn (_: 'T Task , _: ParReturn) = fun x -> Task.FromResult x : 'T Task #endif #if NETSTANDARD2_1 && !FABLE_COMPILER - static member ParReturn (_: 'T ValueTask , _: ParReturn ) = fun (x: 'T) -> ValueTask<'T> x : 'T ValueTask + static member ParReturn (_: 'T ValueTask , _: ParReturn) = fun (x: 'T) -> ValueTask<'T> x : 'T ValueTask #endif - static member inline ParReturn (x: option<'a> , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) - static member inline ParReturn (x: voption<'a> , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) - static member ParReturn (_: list<'a> , _: ParReturn ) = fun x -> List.cycle [x] : list<'a> - // static member ParReturn (x: 'a [] , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) - static member ParReturn (x: 'r -> 'a , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) - static member inline ParReturn (x: 'm * 'a , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) - static member inline ParReturn (x: struct ('m * 'a), _: ParReturn ) = Return.Return (x, Unchecked.defaultof) - static member ParReturn (_: 'a Async , _: ParReturn ) = fun (x: 'a) -> async.Return x - static member inline ParReturn (_: Result<'t, 'e> , _: ParReturn ) = fun x -> if opaqueId false then Error (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e> : 'e) else Ok x : Result<'t,'e> - static member inline ParReturn (_: Choice<'t, 'e> , _: ParReturn ) = fun x -> if opaqueId false then Choice2Of2 (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e> : 'e) else Choice1Of2 x : Choice<'t,'e> + static member ParReturn (x: option<'a> , _: ParReturn) = Return.Return (x, Unchecked.defaultof) + static member ParReturn (x: voption<'a> , _: ParReturn) = Return.Return (x, Unchecked.defaultof) + static member ParReturn (_: list<'a> , _: ParReturn) = fun x -> List.cycle [x] : list<'a> + + [] + static member ParReturn (x: 'a [] , _: ParReturn) = Return.Return (x, Unchecked.defaultof) + + static member ParReturn (x: 'r -> 'a , _: ParReturn) = Return.Return (x, Unchecked.defaultof) + static member inline ParReturn (x: 'm * 'a , _: ParReturn) = Return.Return (x, Unchecked.defaultof) + static member inline ParReturn (x: struct ('m * 'a), _: ParReturn) = Return.Return (x, Unchecked.defaultof) + static member ParReturn (_: 'a Async , _: ParReturn) = fun (x: 'a) -> async.Return x + static member inline ParReturn (_: Result<'t, 'e> , _: ParReturn) = fun x -> if opaqueId false then Error (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e> : 'e) else Ok x : Result<'t,'e> + static member inline ParReturn (_: Choice<'t, 'e> , _: ParReturn) = fun x -> if opaqueId false then Choice2Of2 (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e> : 'e) else Choice1Of2 x : Choice<'t,'e> #if !FABLE_COMPILER - static member ParReturn (x: Expr<'a> , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) + static member ParReturn (x: Expr<'a> , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) #endif - // static member ParReturn (x: ResizeArray<'a>, _: ParReturn ) = Return.Return (x, Unchecked.defaultof) + + [", 10720, IsError = true)>] + static member ParReturn (x: ResizeArray<'a>, _: ParReturn ) = Return.Return (x, Unchecked.defaultof) #endif From 6194a9c75618430b5e0b8afb9befd4c060a972e9 Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Sat, 13 Jan 2024 21:56:03 +0100 Subject: [PATCH 11/27] Align code --- src/FSharpPlus/Control/Parallel.fs | 44 ++++++++++++++---------------- 1 file changed, 21 insertions(+), 23 deletions(-) diff --git a/src/FSharpPlus/Control/Parallel.fs b/src/FSharpPlus/Control/Parallel.fs index b44c69767..d966b007b 100644 --- a/src/FSharpPlus/Control/Parallel.fs +++ b/src/FSharpPlus/Control/Parallel.fs @@ -21,26 +21,24 @@ type ParReturn = static member inline Invoke (x: 'T) : '``ParApplicative<'T>`` = let inline call (mthd: ^M, output: ^R) = ((^M or ^R) : (static member ParReturn : _*_ -> _) output, mthd) call (Unchecked.defaultof, Unchecked.defaultof<'``ParApplicative<'T>``>) x - - - static member ParReturn (_: seq<'a> , _: Default2 ) = fun x -> Seq.initInfinite (fun _ -> x) : seq<'a> - static member ParReturn (_: NonEmptySeq<'a> , _: Default2 ) = fun x -> NonEmptySeq.initInfinite (fun _ -> x) : NonEmptySeq<'a> - static member ParReturn (_: IEnumerator<'a> , _: Default2 ) = Enumerator.unfold (fun x -> Some (x, x)) : _ -> IEnumerator<'a> - static member inline ParReturn (_: 'R , _: Default1 ) = fun (x: 'T) -> ParReturn.InvokeOnInstance x : 'R + static member ParReturn (_: seq<'a> , _: Default2 ) = fun x -> Seq.initInfinite (fun _ -> x) : seq<'a> + static member ParReturn (_: NonEmptySeq<'a> , _: Default2 ) = fun x -> NonEmptySeq.initInfinite (fun _ -> x) : NonEmptySeq<'a> + static member ParReturn (_: IEnumerator<'a> , _: Default2 ) = fun x -> Enumerator.upto None (fun _ -> x) : IEnumerator<'a> + static member inline ParReturn (_: 'R , _: Default1 ) = fun (x: 'T) -> ParReturn.InvokeOnInstance x : 'R static member ParReturn (x: Lazy<'a> , _: ParReturn) = Return.Return (x, Unchecked.defaultof) : _ -> Lazy<'a> #if !FABLE_COMPILER - static member ParReturn (_: 'T Task , _: ParReturn) = fun x -> Task.FromResult x : 'T Task + static member ParReturn (_: 'T Task , _: ParReturn) = fun x -> Task.FromResult x : 'T Task #endif #if NETSTANDARD2_1 && !FABLE_COMPILER - static member ParReturn (_: 'T ValueTask , _: ParReturn) = fun (x: 'T) -> ValueTask<'T> x : 'T ValueTask + static member ParReturn (_: 'T ValueTask , _: ParReturn) = fun (x: 'T) -> ValueTask<'T> x : 'T ValueTask #endif static member ParReturn (x: option<'a> , _: ParReturn) = Return.Return (x, Unchecked.defaultof) static member ParReturn (x: voption<'a> , _: ParReturn) = Return.Return (x, Unchecked.defaultof) - static member ParReturn (_: list<'a> , _: ParReturn) = fun x -> List.cycle [x] : list<'a> + static member ParReturn (_: list<'a> , _: ParReturn) = fun x -> List.cycle [x] : list<'a> [] - static member ParReturn (x: 'a [] , _: ParReturn) = Return.Return (x, Unchecked.defaultof) + static member ParReturn (x: 'a [] , _: ParReturn) = Return.Return (x, Unchecked.defaultof) static member ParReturn (x: 'r -> 'a , _: ParReturn) = Return.Return (x, Unchecked.defaultof) static member inline ParReturn (x: 'm * 'a , _: ParReturn) = Return.Return (x, Unchecked.defaultof) @@ -49,7 +47,7 @@ type ParReturn = static member inline ParReturn (_: Result<'t, 'e> , _: ParReturn) = fun x -> if opaqueId false then Error (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e> : 'e) else Ok x : Result<'t,'e> static member inline ParReturn (_: Choice<'t, 'e> , _: ParReturn) = fun x -> if opaqueId false then Choice2Of2 (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e> : 'e) else Choice1Of2 x : Choice<'t,'e> #if !FABLE_COMPILER - static member ParReturn (x: Expr<'a> , _: ParReturn ) = Return.Return (x, Unchecked.defaultof) + static member ParReturn (x: Expr<'a> , _: ParReturn) = Return.Return (x, Unchecked.defaultof) #endif [", 10720, IsError = true)>] @@ -61,7 +59,7 @@ type ParApply = inherit Default1 #if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 - // static member inline ```` (struct (f: '``ParApplicative<'T->'U>``, x: '``ParApplicative<'T>``), []_output: '``ParApplicative<'U>``, []_mthd:Default1) : '``ParApplicative<'U>`` = ((^``ParApplicative<'T->'U>`` or ^``ParApplicative<'T>`` or ^``ParApplicative<'U>``) : (static member () : _*_ -> _) f, x) + static member ```` (struct (f: Lazy<'T->'U> , x: Lazy<'T> ), []_output: Lazy<'U> , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) static member ```` (struct (f: seq<_> , x: seq<'T> ), []_output: seq<'U> , []_mthd: ParApply) = Seq.map2 (<|) f x static member ```` (struct (f: NonEmptySeq<_> , x: NonEmptySeq<'T> ), []_output: NonEmptySeq<'U> , []_mthd: ParApply) = NonEmptySeq.map2 (<|) f x @@ -107,10 +105,10 @@ type ParApply = #if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 type ParApply with - // static member inline ```` (struct (f: '``Monad<'T->'U>`` , x: '``Monad<'T>`` ) , _output: '``Monad<'U>`` , []_mthd:Default2) : '``Monad<'U>`` = Bind.InvokeOnInstance f (fun (x1: 'T->'U) -> Bind.InvokeOnInstance x (fun x2 -> Return.InvokeOnInstance (x1 x2))) + static member inline ```` (struct (_: ^t when ^t : null and ^t: struct, _: ^u when ^u : null and ^u: struct), _output: ^r when ^r : null and ^r: struct, _mthd: Default1) = id - - static member inline ```` (struct (f: '``Applicative<'T->'U>``, x: '``Applicative<'T>``), _output: '``Applicative<'U>``, []_mthd: Default1) : '``Applicative<'U>`` = ((^``Applicative<'T->'U>`` or ^``Applicative<'T>`` or ^``Applicative<'U>``) : (static member () : _*_ -> _) f, x) + static member inline ```` (struct (f: '``Applicative<'T->'U>``, x: '``Applicative<'T>``), _output: '``Applicative<'U>``, []_mthd: Default1) : '``Applicative<'U>`` = + ((^``Applicative<'T->'U>`` or ^``Applicative<'T>`` or ^``Applicative<'U>``) : (static member () : _*_ -> _) f, x) type ParLift2 = @@ -209,16 +207,16 @@ type ParLift3 with type IsParLeftZero = inherit Default1 - static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = Seq.isEmpty t.Value + static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = Seq.isEmpty t.Value static member IsParLeftZero (_: ref>, _mthd: IsParLeftZero) = false - static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = List.isEmpty t.Value - static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = Array.isEmpty t.Value - static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = IsLeftZero.IsLeftZero (t, Unchecked.defaultof) + static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = List.isEmpty t.Value + static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = Array.isEmpty t.Value + static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = IsLeftZero.IsLeftZero (t, Unchecked.defaultof) #if !FABLE_COMPILER - static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = IsLeftZero.IsLeftZero (t, Unchecked.defaultof) + static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = IsLeftZero.IsLeftZero (t, Unchecked.defaultof) #endif - static member IsParLeftZero (_: ref> , _mthd: IsParLeftZero) = false - static member IsParLeftZero (_: ref> , _mthd: IsParLeftZero) = false + static member IsParLeftZero (_: ref> , _mthd: IsParLeftZero) = false + static member IsParLeftZero (_: ref> , _mthd: IsParLeftZero) = false static member inline Invoke (x: '``ParApplicative<'T>``) : bool = let inline call (mthd: ^M, input: ^I) = @@ -239,4 +237,4 @@ type IsParLeftZero with static member inline IsParLeftZero (t: ref<'``ParApplicative<'T>``> , _mthd: Default1) = (^``ParApplicative<'T>`` : (static member IsParLeftZero : _ -> _) t.Value) static member inline IsParLeftZero (_: ref< ^t> when ^t: null and ^t: struct, _: Default1) = () -#endif \ No newline at end of file +#endif From 9a08136367096c98eaa3c120257bed3c7bc339cf Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Sat, 13 Jan 2024 21:57:20 +0100 Subject: [PATCH 12/27] + Implementation for Compose and NonEmptyList --- .../content/abstraction-par-applicative.fsx | 58 ++++++------------- src/FSharpPlus/Data/Monoids.fs | 9 +++ src/FSharpPlus/Data/NonEmptyList.fs | 13 +++++ 3 files changed, 41 insertions(+), 39 deletions(-) diff --git a/docsrc/content/abstraction-par-applicative.fsx b/docsrc/content/abstraction-par-applicative.fsx index 59c56d5c7..7d0568abd 100644 --- a/docsrc/content/abstraction-par-applicative.fsx +++ b/docsrc/content/abstraction-par-applicative.fsx @@ -29,6 +29,14 @@ Other operations (** static member ParLift2 (f: 'T1 -> 'T2 -> 'T, x1: 'Applicative<'T1>, x2: 'Applicative<'T2>) : 'Applicative<'T> *) + +(** +* ``plift3`` +*) +(** + static member ParLift3 (f: 'T1 -> 'T2 -> 'T3 -> 'T, x1: 'Applicative<'T1>, x2: 'Applicative<'T2>, x3: 'Applicative<'T3>) : 'Applicative<'T> +*) + (** @@ -54,61 +62,33 @@ From F# - ``seq<'T>`` - ``list<'T>`` - - ``array<'T>`` * - - ``'T [,]`` * - - ``'T [,,]`` * - - ``'T [,,,]`` * - ``option<'T>`` * - ``voption<'T>`` * - - ``IObservable<'T>`` - ``Lazy<'T>`` * - ``Async<'T>`` - - ``Result<'T,'U>`` - - ``Choice<'T,'U>`` - - ``KeyValuePair<'Key,'T>`` * - - ``'Monoid * 'T`` * + - ``Result<'T, 'U>`` + - ``Choice<'T, 'U>`` + - ``KeyValuePair<'Key, 'T>`` * + - ``'Monoid * 'T`` * - ``ValueTuple<'Monoid, 'T>`` * - ``Task<'T>`` - ``ValueTask<'T>`` - - ``'R->'T`` * + - ``'R -> 'T`` * - ``Expr<'T>`` * - - ``ResizeArray<'T>`` * + From F#+ - - [``Identity<'T>``](type-identity.html) - - [``Cont<'R,'T>``](type-cont.html) - - [``ContT<'R,'T>``](type-contt.html) - - [``Reader<'R,'T>``](type-reader.html) - - [``ReaderT<'R,'Monad<'T>>``](type-readert.html) - - [``Writer<'Monoid,'T>``](type-writer.html) - - [``WriterT<'Monad<'T * 'Monoid>>``](type-writert.html) - - [``State<'S,'T * 'S>``](type-state.html) - - [``StateT<'S,'Monad<'T * 'S>>``](type-statet.html) - - [``OptionT<'Monad>``](type-optiont.html) - - [``ValueOptionT<'Monad>``](type-valueoptiont.html) - - [``SeqT<'Monad>``](type-seqt.html) - - [``ListT<'Monad>``](type-listt.html) - - [``ResultT<'Monad>``](type-resultt.html) - - [``ChoiceT<'Monad>``](type-choicet.html) - - [``Free<'Functor<'T>,'T>``](type-free.html) + - [``NonEmptySeq<'T>``] - [``NonEmptyList<'T>``](type-nonempty.html) - - [``Validation<'Error,'T>``](type-validation.html) - - [``ZipList<'T>``](type-ziplist.html) - - [``ParallelArray<'T>``](type-parallelarray.html) - - [``Const<'C,'T>``](type-const.html) - [``Compose<'Applicative1<'Applicative2<'T>>>``](type-compose.html) - - [``DList<'T>``](type-dlist.html) - - [``Vector<'T,'Dimension>``](type-vector.html) - - [``Matrix<'T,'Rows,'Columns>``](type-matrix.html) + + (*) The operation is the same as that for the normal applicative -Restricted: - - ``string`` - - ``StringBuilder`` - - ``Set<'T>`` - - ``IEnumerator<'T>`` Only for <*> operation: + - ``array<'T>`` + - ``ResizeArray<'T>`` - ``Map<'Key, 'T>`` - ``Dictionary<'Key, 'T>`` - ``IDictionary<'Key, 'T>`` diff --git a/src/FSharpPlus/Data/Monoids.fs b/src/FSharpPlus/Data/Monoids.fs index 69da14a38..8c4e637fa 100644 --- a/src/FSharpPlus/Data/Monoids.fs +++ b/src/FSharpPlus/Data/Monoids.fs @@ -180,6 +180,15 @@ type Compose<'``functorF<'functorG<'t>>``> = Compose of '``functorF<'functorG<'t static member inline get_Empty () = Compose (getEmpty ()) : Compose<'``AlternativeF<'ApplicativeG<'T>``> static member inline (<|>) (Compose x, Compose y) = Compose (x <|> y) : Compose<'``AlternativeF<'ApplicativeG<'T>``> + // Parallel Applicative + static member inline () (Compose (f: '``ApplicativeF<'ApplicativeG<'T->'U>``), Compose (x: '``ApplicativeF<'ApplicativeG<'T>``)) = + Compose (((() : '``ApplicativeG<'T->'U>`` -> '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>``) f: '``ApplicativeF<'ApplicativeG<'T>->'ApplicativeG<'U>`` ) x: '``ApplicativeF<'ApplicativeG<'U>``) + + static member inline ParLift2 (f: 'T -> 'U -> 'V, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``)) = + Compose (ParLift2.Invoke (ParLift2.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>``) x y: '``ApplicativeF<'ApplicativeG<'V>``) + + static member inline ParLift3 (f: 'T -> 'U -> 'V -> 'W, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``), Compose (z: '``ApplicativeF<'ApplicativeG<'V>``)) = + Compose (ParLift3.Invoke (ParLift3.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>`` -> '``ApplicativeG<'W>``) x y z: '``ApplicativeF<'ApplicativeG<'W>``) /// Basic operations on Compose [] diff --git a/src/FSharpPlus/Data/NonEmptyList.fs b/src/FSharpPlus/Data/NonEmptyList.fs index 38281c520..ba6fb2578 100644 --- a/src/FSharpPlus/Data/NonEmptyList.fs +++ b/src/FSharpPlus/Data/NonEmptyList.fs @@ -86,6 +86,11 @@ module NonEmptyList = /// to each of the elements of the two non empty list pairwise. /// If one list is shorter, excess elements are discarded from the right end of the longer list. let map2Shortest f l1 l2 = { Head = f l1.Head l2.Head; Tail = List.map2Shortest f l1.Tail l2.Tail } + + /// Safely build a new non empty list whose elements are the results of applying the given function + /// to each of the elements of the three non empty list pointwise. + /// If one list is shorter, excess elements are discarded from the right end of the longer list. + let map3Shortest f l1 l2 l3 = { Head = f l1.Head l2.Head l3.Head; Tail = List.map3Shortest f l1.Tail l2.Tail l3.Tail } /// Build a new non empty list whose elements are the results of applying the given function with index /// to each of the elements of the non empty list. @@ -246,9 +251,17 @@ type NonEmptyList<'t> with let r = NonEmptyList.toList f NonEmptyList.toList x {Head = r.Head; Tail = r.Tail} + static member () (f: NonEmptyList<'T->'U>, x: NonEmptyList<'T>) = NonEmptyList.map2Shortest (<|) f x + static member Lift2 (f: 'T -> 'U -> 'V, x, y) = NonEmptyList.ofList (List.lift2 f (NonEmptyList.toList x) (NonEmptyList.toList y)) static member Lift3 (f: 'T -> 'U -> 'V -> 'W, x, y, z) = NonEmptyList.ofList (List.lift3 f (NonEmptyList.toList x) (NonEmptyList.toList y) (NonEmptyList.toList z)) + [] + static member ParLift2 (f: 'T -> 'U -> 'V, x, y) = NonEmptyList.map2Shortest f x y + + [] + static member ParLift3 (f: 'T -> 'U -> 'V -> 'W, x, y, z) = NonEmptyList.map3Shortest f x y z + static member Extract {Head = h; Tail = _} = h : 't #if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 From 2253998bf7cc33d2624e69dd7b704fe219195074 Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Sat, 13 Jan 2024 21:57:51 +0100 Subject: [PATCH 13/27] Applicative (math) operators --- src/FSharpPlus/Math/Applicative.fs | 53 ++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) diff --git a/src/FSharpPlus/Math/Applicative.fs b/src/FSharpPlus/Math/Applicative.fs index c21311508..790822718 100644 --- a/src/FSharpPlus/Math/Applicative.fs +++ b/src/FSharpPlus/Math/Applicative.fs @@ -64,4 +64,57 @@ module Applicative = let inline ( >=. ) (x: 'T) (y: '``Functor<'T>``) = map ((>=) x) y : '``Functor`` let inline ( .>=. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (>=) x <*> y : '``Applicative`` +/// Math Operators ready to use over (parallel) Applicative Functors. +module ParallelApplicative = + + let inline ( ~-. ) (x: '``Functor<'T>``) = map ((~-)) x : '``Functor<'T>`` + + let inline ( .+ ) (x: '``Functor<'T>``) (y: 'T) = map ((+)/> y) x : '``Functor<'T>`` + let inline ( +. ) (x: 'T) (y: '``Functor<'T>``) = map ((+) x) y : '``Functor<'T>`` + let inline ( .+. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (+) x y : '``Applicative<'T>`` + + let inline ( .- ) (x: '``Functor<'T>``) (y: 'T) = map ((-)/> y) x : '``Functor<'T>`` + let inline ( -. ) (x: 'T) (y: '``Functor<'T>``) = map ((-) x) y : '``Functor<'T>`` + let inline ( .-. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (-) x y : '``Applicative<'T>`` + + let inline ( .* ) (x: '``Functor<'T>``) (y: 'T) = map ((*)/> y) x : '``Functor<'T>`` + let inline ( *. ) (x: 'T) (y: '``Functor<'T>``) = map ((*) x) y : '``Functor<'T>`` + let inline ( .*. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (*) x y : '``Applicative<'T>`` + + let inline ( .% ) (x: '``Functor<'T>``) (y: 'T) = map ((%)/> y) x : '``Functor<'T>`` + let inline ( %. ) (x: 'T) (y: '``Functor<'T>``) = map ((%) x) y : '``Functor<'T>`` + let inline ( .%. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (%) x y : '``Applicative<'T>`` + + let inline ( ./ ) (x: '``Functor<'T>``) (y: 'T) = map ((/)/> y) x : '``Functor<'T>`` + let inline ( /. ) (x: 'T) (y: '``Functor<'T>``) = map ((/) x) y : '``Functor<'T>`` + let inline ( ./. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (/) x y : '``Applicative<'T>`` + + let inline ( .= ) (x: '``Functor<'T>``) (y: 'T) = map ((=)/> y) x : '``Functor`` + let inline ( =. ) (x: 'T) (y: '``Functor<'T>``) = map ((=) x) y : '``Functor`` + let inline ( .=. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (=) x y : '``Applicative`` + + let inline ( .> ) (x: '``Functor<'T>``) (y: 'T) = map ((>)/> y) x : '``Functor`` + let inline ( >. ) (x: 'T) (y: '``Functor<'T>``) = map ((>) x) y : '``Functor`` + let inline ( .>. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (>) x y : '``Applicative`` + + let inline ( .< ) (x: '``Functor<'T>``) (y: 'T) = map ((<)/> y) x : '``Functor`` + let inline ( <. ) (x: 'T) (y: '``Functor<'T>``) = map ((<) x) y : '``Functor`` + let inline ( .<. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (<) x y : '``Applicative`` + + let inline (.|| ) (x: '``Functor``) (y: bool) = map ((||)/> y) x : '``Functor`` + let inline ( ||.) (x: bool) (y: '``Functor``) = map ((||) x) y : '``Functor`` + let inline (.||.) (x: '``Applicative``) (y: '``Applicative``) = (||) x y : '``Applicative`` + + let inline (.&& ) (x: '``Functor``) (y: bool) = map ((&&)/> y) x : '``Functor`` + let inline ( &&.) (x: bool) (y: '``Functor``) = map ((&&) x) y : '``Functor`` + let inline (.&&.) (x: '``Applicative``) (y: '``Applicative``) = (&&) x y : '``Applicative`` + + let inline ( .<= ) (x: '``Functor<'T>``) (y: 'T) = map ((<=)/> y) x : '``Functor`` + let inline ( <=. ) (x: 'T) (y: '``Functor<'T>``) = map ((<=) x) y : '``Functor`` + let inline ( .<=. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (<=) x y : '``Applicative`` + + let inline ( .>= ) (x: '``Functor<'T>``) (y: 'T) = map ((>=)/> y) x : '``Functor`` + let inline ( >=. ) (x: 'T) (y: '``Functor<'T>``) = map ((>=) x) y : '``Functor`` + let inline ( .>=. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (>=) x y : '``Applicative`` + #endif \ No newline at end of file From 3a4ee60b2485028c93e5a2cdcc8642e9c77e2ece Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Sun, 14 Jan 2024 09:12:56 +0100 Subject: [PATCH 14/27] More docs --- docsrc/content/abstraction-par-applicative.fsx | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/docsrc/content/abstraction-par-applicative.fsx b/docsrc/content/abstraction-par-applicative.fsx index 7d0568abd..74bfb7159 100644 --- a/docsrc/content/abstraction-par-applicative.fsx +++ b/docsrc/content/abstraction-par-applicative.fsx @@ -110,6 +110,16 @@ Examples open FSharpPlus + +// pointwise operations + +let arr1 = (+) [|1;2;3|] <*> [|10;20;30|] +let arr2 = (+) [|1;2;3|] [|10;20;30|] + +// val arr1: int array = [|11; 21; 31; 12; 22; 32; 13; 23; 33|] +// val arr2: int array = [|11; 22; 33|] + + // Validations let validated = par2 { From c071bae62d453f725454edc0d1f4af8611e23f5c Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Sun, 14 Jan 2024 09:14:18 +0100 Subject: [PATCH 15/27] + Tests --- tests/FSharpPlus.Tests/Applicatives.fs | 35 +++++++++++++++++++ .../FSharpPlus.Tests/FSharpPlus.Tests.fsproj | 1 + 2 files changed, 36 insertions(+) create mode 100644 tests/FSharpPlus.Tests/Applicatives.fs diff --git a/tests/FSharpPlus.Tests/Applicatives.fs b/tests/FSharpPlus.Tests/Applicatives.fs new file mode 100644 index 000000000..d9269a8c6 --- /dev/null +++ b/tests/FSharpPlus.Tests/Applicatives.fs @@ -0,0 +1,35 @@ +namespace FSharpPlus.Tests + +open System +open System.Collections.ObjectModel +open FSharpPlus +open FSharpPlus.Data +open NUnit.Framework +open Helpers + +module Applicatives = + + [] + let presultAndParApply () = + let res9n5 = map ((+) 1) [8;4] + CollectionAssert.AreEqual ([9; 5], res9n5) + + let red20n30 = presult (+) presult 10 NonEmptySeq.ofList [10;20] + CollectionAssert.AreEqual (NonEmptySeq.ofList [20; 30], red20n30) + + + [] + let parApply () = + let arr1 = par2 { + let! x1 = async { return [|1; 2; 3|] } + and! x2 = async { return [|10; 20; 30|] } + and! x3 = async { return [|100; 200; 300|] } + and! x4 = async { return [|1000; 2000; 3000|] } + return x1 + x2 + x3 + x4 } + CollectionAssert.AreEqual ([|1111; 2222; 3333|], arr1 |> Async.RunSynchronously) + + let arr2 = (+) [|1;2;3|] [|10;20;30|] + CollectionAssert.AreEqual ([|11; 22; 33|], arr2) + + let arr3 = (+) Compose (async { return [|1;2;3|] } ) Compose (async { return [|10;20;30|] }) + CollectionAssert.AreEqual ([|11; 22; 33|], arr3 |> Compose.run |> Async.RunSynchronously) diff --git a/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj b/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj index a8089a3ec..3276b9565 100644 --- a/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj +++ b/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj @@ -18,6 +18,7 @@ + From 28d6e4fcad99eab6f4f90daabba8f313dc902cf4 Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Sun, 21 Jan 2024 11:46:34 +0100 Subject: [PATCH 16/27] + ptraverse and psequence --- src/FSharpPlus/Control/MonadOps.fs | 2 + src/FSharpPlus/Control/Parallel.fs | 17 +- src/FSharpPlus/Control/Traversable.fs | 245 +++++++++++++++++++++++- src/FSharpPlus/Extensions/Extensions.fs | 33 ++++ src/FSharpPlus/Operators.fs | 15 ++ 5 files changed, 310 insertions(+), 2 deletions(-) diff --git a/src/FSharpPlus/Control/MonadOps.fs b/src/FSharpPlus/Control/MonadOps.fs index 9e7409f20..ae972a90d 100644 --- a/src/FSharpPlus/Control/MonadOps.fs +++ b/src/FSharpPlus/Control/MonadOps.fs @@ -8,6 +8,8 @@ module internal MonadOps = let inline (>>=) x f = Bind.Invoke x f let inline result x = Return.Invoke x let inline (<*>) f x = Apply.Invoke f x + let inline presult x = ParReturn.Invoke x + let inline () f x = ParApply.Invoke f x let inline (<|>) x y = Append.Invoke x y let inline (>=>) (f: 'a->'``Monad<'b>``) (g: 'b->'``Monad<'c>``) (x: 'a) : '``Monad<'c>`` = f x >>= g diff --git a/src/FSharpPlus/Control/Parallel.fs b/src/FSharpPlus/Control/Parallel.fs index d966b007b..66d90911b 100644 --- a/src/FSharpPlus/Control/Parallel.fs +++ b/src/FSharpPlus/Control/Parallel.fs @@ -1,6 +1,7 @@ namespace FSharpPlus.Control open System +open System.Text open System.Runtime.InteropServices open System.Collections.Generic open System.Threading.Tasks @@ -53,6 +54,15 @@ type ParReturn = [", 10720, IsError = true)>] static member ParReturn (x: ResizeArray<'a>, _: ParReturn ) = Return.Return (x, Unchecked.defaultof) + //Restricted + [] + static member ParReturn (_: string , _: ParReturn ) = fun (x: char) -> string x : string + [] + static member ParReturn (_: StringBuilder , _: ParReturn ) = fun (x: char) -> new StringBuilder (string x) : StringBuilder + [] + static member ParReturn (_: 'a Set , _: ParReturn ) = fun (x: 'a ) -> Set.singleton x + static member ParReturn (_: 'a Set2 , _: ParReturn ) = fun (_: 'a ) -> Set2() : 'a Set2 + #endif type ParApply = @@ -80,7 +90,12 @@ type ParApply = static member ```` (struct (f: voption<_> , x: voption<'T> ), []_output: voption<'U> , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) static member inline ```` (struct (f: Result<_,'E> , x: Result<'T,'E> ), []_output: Result<'b,'E> , []_mthd: ParApply) : Result<'U, 'E> = Result.apply2With Plus.Invoke (<|) f x static member inline ```` (struct (f: Choice<_,'E> , x: Choice<'T,'E> ), []_output: Choice<'b,'E> , []_mthd: ParApply) : Choice<'U, 'E> = Choice.apply2With Plus.Invoke (<|) f x - static member inline ```` (struct (f: KeyValuePair<'Key,_>, x: KeyValuePair<'Key,'T>), []_output: KeyValuePair<'Key,'U>, []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member inline ```` (struct (f: KeyValuePair<'Key,_>, x: KeyValuePair<'Key,'T>), []_output: KeyValuePair<'Key,'U>, []_mthd: Default2) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member inline ```` (struct (f: KeyValuePair2<_,_>, x: KeyValuePair2<_,'T> ) , _output: KeyValuePair2<_,'U> , _mthd: Default2) : KeyValuePair2<'Key,'U> = + let a, b = f.Key, x.Key + let f, x = f.Value, x.Value + KeyValuePair2 (Plus.Invoke a b, f x) + static member ```` (struct (f: Map<'Key,_> , x: Map<'Key,'T> ), []_output: Map<'Key,'U> , []_mthd: ParApply) : Map<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) static member ```` (struct (f: Dictionary<'Key,_> , x: Dictionary<'Key,'T> ), []_output: Dictionary<'Key,'U> , []_mthd: ParApply) : Dictionary<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) diff --git a/src/FSharpPlus/Control/Traversable.fs b/src/FSharpPlus/Control/Traversable.fs index 9b4363c3d..08122741e 100644 --- a/src/FSharpPlus/Control/Traversable.fs +++ b/src/FSharpPlus/Control/Traversable.fs @@ -244,4 +244,247 @@ type Sequence with let inline call (a: 'a, b: 'b) = call_3 (a, b, Unchecked.defaultof<'R>) : 'R call (Unchecked.defaultof, t) -#endif + + +// Parallel traversables + + +type ParSequence = + inherit Default1 + static member inline InvokeOnInstance (t: '``ParTraversable<'Functor<'T>>``) = (^``ParTraversable<'Functor<'T>>`` : (static member ParSequence : _ -> _) t) : '``Functor<'ParTraversable<'T>>`` + + [] + static member inline ForInfiniteSequences (t: seq<_>, isFailure, conversion) = + let add x y = y :: x + let mutable go = true + 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 + if isEmpty then r <- Map.Invoke List.singleton e.Current + else r <- Map.Invoke add r e.Current + isEmpty <- false + if isEmpty then ParReturn.Invoke (conversion []) + else Map.Invoke (List.rev >> conversion) r + +type ParTraverse = + inherit Default1 + static member inline InvokeOnInstance f (t: ^a) = (^a : (static member ParTraverse : _ * _ -> 'R) t, f) + + static member inline ParTraverse (t: '``ParTraversable<'T>``, f: 'T -> '``Functor<'U>``, []_output: '``Functor<'ParTraversable<'U>>``, []_impl: Default4) = + #if TEST_TRACE + Traces.add "ParTraverse 'ParTraversable, 'T -> Functor<'U>" + #endif + let mapped = Map.Invoke f t : '``ParTraversable<'Functor<'U>>`` + (^``ParTraversable<'T>`` : (static member ParSequence : _ -> _) mapped) : '``Functor<'ParTraversable<'U>>`` + + static member inline ParTraverse (t: Id<_>, f, []_output: 'R, []_impl: Default3) = + #if TEST_TRACE + Traces.add "ParTraverse Id" + #endif + Map.Invoke Id.create (f (Id.run t)) + + static member inline ParTraverse (t: _ seq, f, []_output: 'R, []_impl: Default3) = + #if TEST_TRACE + Traces.add "ParTraverse seq" + #endif + let cons x y = seq {yield x; yield! y} + let cons_f x ys = Map.Invoke (cons: 'a -> seq<_> -> seq<_>) (f x) ys + Seq.foldBack cons_f t (ParReturn.Invoke Seq.empty) + + static member inline ParTraverse (t: _ NonEmptySeq, f, []_output: 'R, []_impl: Default3) = + #if TEST_TRACE + Traces.add "ParTraverse NonEmptySeq" + #endif + let cons x y = seq {yield x; yield! y} + let cons_f x ys = Map.Invoke (cons: 'a -> seq<_> -> seq<_>) (f x) ys + Map.Invoke NonEmptySeq.ofSeq (Seq.foldBack cons_f t (ParReturn.Invoke Seq.empty)) + + static member inline ParTraverse (t: seq<'T>, f: 'T -> '``Functor<'U>``, []_output: '``Functor>``, []_impl: Default2) = + #if TEST_TRACE + Traces.add "ParTraverse seq, 'T -> Functor<'U>" + #endif + let mapped = Seq.map f t + ParSequence.ForInfiniteSequences (mapped, IsParLeftZero.Invoke, List.toSeq) : '``Functor>`` + + static member inline ParTraverse (t: NonEmptySeq<'T>, f: 'T -> '``Functor<'U>``, []_output: '``Functor>``, []_impl: Default2) = + #if TEST_TRACE + Traces.add "ParTraverse NonEmptySeq, 'T -> Functor<'U>" + #endif + let mapped = NonEmptySeq.map f t + ParSequence.ForInfiniteSequences (mapped, IsParLeftZero.Invoke, NonEmptySeq.ofList) : '``Functor>`` + + static member inline ParTraverse (t: ^a, f, []_output: 'R, []_impl: Default1) : 'R = + #if TEST_TRACE + Traces.add "ParTraverse ^a" + #endif + ParTraverse.InvokeOnInstance f t + static member inline ParTraverse (_: ^a when ^a : null and ^a :struct, _, _: 'R, _impl: Default1) = id + + #if !FABLE_COMPILER + static member ParTraverse (t: 't seq, f: 't -> Async<'u>, []_output: Async>, []_impl: ParTraverse) : Async> = async { + #if TEST_TRACE + Traces.add "ParTraverse 't seq, 't -> Async<'u>" + #endif + + let! ct = Async.CancellationToken + return seq { + use enum = t.GetEnumerator () + while enum.MoveNext() do + yield Async.RunSynchronously (f enum.Current, cancellationToken = ct) }} + #endif + + #if !FABLE_COMPILER + static member ParTraverse (t: 't NonEmptySeq, f: 't -> Async<'u>, []_output: Async>, []_impl: ParTraverse) : Async> = async { + #if TEST_TRACE + Traces.add "ParTraverse 't NonEmptySeq, 't -> Async<'u>" + #endif + + let! ct = Async.CancellationToken + return seq { + use enum = t.GetEnumerator () + while enum.MoveNext() do + yield Async.RunSynchronously (f enum.Current, cancellationToken = ct) } |> NonEmptySeq.unsafeOfSeq } + #endif + + static member ParTraverse (t: Id<'t>, f: 't -> option<'u>, []_output: option>, []_impl: ParTraverse) = + #if TEST_TRACE + Traces.add "ParTraverse Id, 't -> option<'u>" + #endif + Option.map Id.create (f (Id.run t)) + + static member inline ParTraverse (t: option<_>, f, []_output: 'R, []_impl: ParTraverse) : 'R = + #if TEST_TRACE + Traces.add "ParTraverse option" + #endif + match t with Some x -> Map.Invoke Some (f x) | _ -> ParReturn.Invoke None + + static member inline ParTraverse (t: voption<_>, f, []_output: 'R, []_impl: ParTraverse) : 'R = + #if TEST_TRACE + Traces.add "ParTraverse voption" + #endif + match t with ValueSome x -> Map.Invoke ValueSome (f x) | _ -> ParReturn.Invoke ValueNone + + static member inline ParTraverse (t:Map<_,_> , f, []_output: 'R, []_impl: ParTraverse) : 'R = + #if TEST_TRACE + Traces.add "ParTraverse Map" + #endif + let insert_f m k v = Map.Invoke (Map.add k) v m + Map.fold insert_f (ParReturn.Invoke Map.empty) (Map.mapValues f t) + + static member inline ParTraverse (t: Result<'T,'Error>, f: 'T -> '``Functor<'U>``, []_output: '``Functor>``, []_impl: ParTraverse) : '``Functor>`` = + #if TEST_TRACE + Traces.add "ParTraverse Result, 'T -> Functor<'U>" + #endif + match t with + | Ok a -> Map.Invoke Result<'U, 'Error>.Ok (f a) + | Error e -> ParReturn.Invoke (Result<'U, 'Error>.Error e) + + static member inline ParTraverse (t: Choice<'T,'Error>, f: 'T -> '``Functor<'U>``, []_output: '``Functor>``, []_impl: ParTraverse) : '``Functor>`` = + #if TEST_TRACE + Traces.add "ParTraverse Choice, 'T -> Functor<'U>" + #endif + match t with + | Choice1Of2 a -> Map.Invoke Choice<'U,'Error>.Choice1Of2 (f a) + | Choice2Of2 e -> ParReturn.Invoke (Choice<'U,'Error>.Choice2Of2 e) + + static member inline ParTraverse (t:list<_>,f , []_output: 'R, []_impl: ParTraverse) : 'R = + #if TEST_TRACE + Traces.add "ParTraverse list" + #endif + let rec loop acc = function + | [] -> acc + | x::xs -> + let v = f x + loop (v::acc) xs + let cons_f x xs = Map.Invoke List.cons xs x + List.fold cons_f (ParReturn.Invoke []) (loop [] t) + + static member inline ParTraverse (t:_ [],f , []_output: 'R, []_impl: ParTraverse) : 'R = + #if TEST_TRACE + Traces.add "ParTraverse []" + #endif + let cons x y = Array.append [|x|] y + let rec loop acc = function + | [||] -> acc + | xxs -> + let x, xs = Array.head xxs, Array.tail xxs + let v = f x + loop (cons v acc) xs + let cons_f x xs = Map.Invoke cons xs x + Array.fold cons_f (ParReturn.Invoke [||]) (loop [||] t) + + static member inline Invoke (f: 'T -> '``Functor<'U>``) (t: '``ParTraversable<'T>``) : '``Functor<'ParTraversable<'U>>`` = + let inline call_3 (a: ^a, b: ^b, c: ^c, f) = ((^a or ^b or ^c) : (static member ParTraverse : _*_*_*_ -> _) b, f, c, a) + let inline call (a: 'a, b: 'b, f) = call_3 (a, b, Unchecked.defaultof<'R>, f) : 'R + call (Unchecked.defaultof, t, f) + + +type ParSequence with + + static member inline ParSequence (t: _ seq, []_output: 'R, []_impl: Default5) : 'R = + let cons x y = seq { yield x; yield! y } + let cons_f x ys = Map.Invoke (cons: 'a -> seq<_> -> seq<_>) x ys + Seq.foldBack cons_f t (ParReturn.Invoke Seq.empty) + + static member inline ParSequence (t: seq<'``Applicative<'T>``>, []_output: '``Applicative>`` , []_impl: Default4) : '``Applicative>`` = + ParSequence.ForInfiniteSequences (t, IsParLeftZero.Invoke, List.toSeq) + + static member ParSequence (t: seq> , []_output: option> , []_impl: Default3) : option> = Option.Sequence t + #if !FABLE_COMPILER + static member ParSequence (t: seq> , []_output: voption> , []_impl: Default3) : voption> = ValueOption.Sequence t + #endif + static member inline ParSequence (t: seq>, []_output: Result, 'e>, []_impl: Default3) : Result, 'e> = Result.Parallel ((++), t) + static member inline ParSequence (t: seq>, []_output: Choice, 'e>, []_impl: Default3) : Choice, 'e> = Choice.Parallel ((++), t) + static member ParSequence (t: seq> , []_output: list> , []_impl: Default3) : list> = ParSequence.ForInfiniteSequences (t, List.isEmpty, List.toSeq) + // static member ParSequence (t: seq<'t []> , []_output: seq<'t> [] , []_impl: Default3) : seq<'t> [] = ParSequence.ForInfiniteSequences (t, Array.isEmpty, List.toSeq) + + #if !FABLE_COMPILER + static member ParSequence (t: seq> , []_output: Async> , []_impl: Default3) : Async> = Async.Parallel t |> Async.map Array.toSeq + #endif + static member inline ParSequence (t: NonEmptySeq<'``Applicative<'T>``>, []_output: '``Applicative>`` , []_impl: Default4) : '``Applicative>`` = ParSequence.ForInfiniteSequences (t, IsParLeftZero.Invoke, NonEmptySeq.ofList) + static member ParSequence (t: NonEmptySeq> , []_output: option> , []_impl: Default3) : option> = Option.Sequence t |> Option.map NonEmptySeq.unsafeOfSeq + static member inline ParSequence (t: NonEmptySeq>, []_output: Result, 'e>, []_impl: Default3) : Result, 'e> = Result.Parallel ((++), t) |> Result.map NonEmptySeq.unsafeOfSeq + static member inline ParSequence (t: NonEmptySeq>, []_output: Choice, 'e>, []_impl: Default3) : Choice, 'e> = Choice.Parallel ((++), t) |> Choice.map NonEmptySeq.unsafeOfSeq + static member ParSequence (t: NonEmptySeq> , []_output: list> , []_impl: Default3) : list> = ParSequence.ForInfiniteSequences(t, List.isEmpty , NonEmptySeq.ofList) + // static member ParSequence (t: NonEmptySeq<'t []> , []_output: NonEmptySeq<'t> [] , []_impl: Default3) : NonEmptySeq<'t> [] = ParSequence.ForInfiniteSequences(t, Array.isEmpty, NonEmptySeq.ofList) + #if !FABLE_COMPILER + static member ParSequence (t: NonEmptySeq> , []_output: Async> , []_impl: Default3) = Async.Parallel t |> Async.map NonEmptySeq.unsafeOfSeq : Async> + #endif + + static member inline ParSequence (t: ^a , []_output: 'R, []_impl: Default2) : 'R = ParTraverse.InvokeOnInstance id t + static member inline ParSequence (t: ^a , []_output: 'R, []_impl: Default1) : 'R = ParSequence.InvokeOnInstance t + + static member inline ParSequence (t: option<_> , []_output: 'R, []_impl: ParSequence) : 'R = match t with Some x -> Map.Invoke Some x | _ -> ParReturn.Invoke None + #if !FABLE_COMPILER + static member inline ParSequence (t: voption<_>, []_output: 'R, []_impl: ParSequence) : 'R = match t with ValueSome x -> Map.Invoke ValueSome x | _ -> ParReturn.Invoke ValueNone + #endif + static member inline ParSequence (t: list<_> , []_output: 'R, []_impl: ParSequence) : 'R = ParSequence.ForInfiniteSequences(t, IsParLeftZero.Invoke, id) + + static member inline ParSequence (t: Map<_,_> , []_output: 'R, []_impl: ParSequence) : 'R = + let insert_f k x ys = Map.Invoke (Map.add k) x ys + Map.foldBack insert_f t (ParReturn.Invoke Map.empty) + + static member inline ParSequence (t: Result<'``Functor<'T>``,'Error>, []_output: '``Functor>``, []_impl: ParSequence) : '``Functor>`` = + match t with + | Ok a -> Map.Invoke Result<'T,'Error>.Ok a + | Error e -> ParReturn.Invoke (Result<'T,'Error>.Error e) + + static member inline ParSequence (t: Choice<'``Functor<'T>``,'Error>, []_output: '``Functor>``, []_impl: ParSequence) : '``Functor>`` = + match t with + | Choice1Of2 a -> Map.Invoke Choice<'T,'Error>.Choice1Of2 a + | Choice2Of2 e -> ParReturn.Invoke (Choice<'T,'Error>.Choice2Of2 e) + + static member inline ParSequence (t: _ [] , []_output: 'R , []_impl: ParSequence) : 'R = ParSequence.ForInfiniteSequences(t, IsParLeftZero.Invoke, Array.ofList) + + static member inline ParSequence (t: Id<'``Functor<'T>``> , []_output: '``Functor>`` , []_impl: ParSequence) : '``Functor>`` = ParTraverse.Invoke id t + + static member inline ParSequence (t: ResizeArray<'``Functor<'T>``>, []_output: '``Functor>`` , []_impl: ParSequence) : '``Functor>``= ParTraverse.Invoke id t + + static member inline Invoke (t: '``ParTraversable<'Applicative<'T>>``) : '``Applicative<'ParTraversable<'T>>`` = + let inline call_3 (a: ^a, b: ^b, c: ^c) = ((^a or ^b or ^c) : (static member ParSequence : _*_*_ -> _) b, c, a) + let inline call (a: 'a, b: 'b) = call_3 (a, b, Unchecked.defaultof<'R>) : 'R + call (Unchecked.defaultof, t) + +#endif \ No newline at end of file diff --git a/src/FSharpPlus/Extensions/Extensions.fs b/src/FSharpPlus/Extensions/Extensions.fs index 1d22dd65b..d34a8fc97 100644 --- a/src/FSharpPlus/Extensions/Extensions.fs +++ b/src/FSharpPlus/Extensions/Extensions.fs @@ -208,6 +208,23 @@ module Extensions = | ValueSome x -> Choice2Of2 x #endif + /// Returns all Errors combined, otherwise a sequence of all elements. + static member Parallel (combiner, t: seq>) = + let mutable error = ValueNone + let res = Seq.toArray (seq { + use e = t.GetEnumerator () + while e.MoveNext () do + match e.Current, error with + | Choice1Of2 v, ValueNone -> yield v + | Choice2Of2 e, ValueNone -> error <- ValueSome e + | Choice2Of2 e, ValueSome x -> error <- ValueSome (combiner x e) + | _ -> () }) + + match error with + | ValueNone -> Choice1Of2 (Array.toSeq res) + | ValueSome e -> Choice2Of2 e + + type Result<'t, 'error> with /// Returns the first Error if it contains an Error element, otherwise a list of all elements @@ -236,3 +253,19 @@ module Extensions = | ValueNone -> Ok (accumulator.Close () |> Array.toSeq) | ValueSome x -> Error x #endif + + /// Returns all Errors combined, otherwise a sequence of all elements. + static member Parallel (combiner, t: seq>) = + let mutable error = ValueNone + let res = Seq.toArray (seq { + use e = t.GetEnumerator () + while e.MoveNext () do + match e.Current, error with + | Ok v , ValueNone -> yield v + | Error e, ValueNone -> error <- ValueSome e + | Error e, ValueSome x -> error <- ValueSome (combiner x e) + | _ -> () }) + + match error with + | ValueNone -> Ok (Array.toSeq res) + | ValueSome e -> Error e diff --git a/src/FSharpPlus/Operators.fs b/src/FSharpPlus/Operators.fs index 6153c7fe4..69c778049 100644 --- a/src/FSharpPlus/Operators.fs +++ b/src/FSharpPlus/Operators.fs @@ -724,6 +724,21 @@ module Operators = let inline sequence (t: '``Traversable<'Functor<'T>>``) : '``Functor<'Traversable<'T>>`` = Sequence.Invoke t + // Traversable (Parallel / Pointwise) + + /// + /// Map each element of a structure to an action, evaluate these actions from left to right, pointwise, or in parallel, and collect the results. + /// + /// Traversable + let inline ptraverse (f: 'T->'``Functor<'U>``) (t: '``Traversable<'T>``) : '``Functor<'Traversable<'U>>`` = ParTraverse.Invoke f t + + /// + /// Evaluate each action in the structure from left to right, pointwise, or in parallel, and collect the results. + /// + /// Traversable + let inline psequence (t: '``Traversable<'Functor<'T>>``) : '``Functor<'Traversable<'T>>`` = ParSequence.Invoke t + + // Bifoldable /// From bdc93576e22159d008290d31cd834e3233dd4d6d Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Sun, 21 Jan 2024 17:28:42 +0100 Subject: [PATCH 17/27] Enable/optimize NonEmpty traversals --- src/FSharpPlus/Control/Traversable.fs | 27 +++++++++++++-------------- src/FSharpPlus/Data/NonEmptyList.fs | 19 +++++++++++++++++++ 2 files changed, 32 insertions(+), 14 deletions(-) diff --git a/src/FSharpPlus/Control/Traversable.fs b/src/FSharpPlus/Control/Traversable.fs index 08122741e..b09393aad 100644 --- a/src/FSharpPlus/Control/Traversable.fs +++ b/src/FSharpPlus/Control/Traversable.fs @@ -254,7 +254,7 @@ type ParSequence = static member inline InvokeOnInstance (t: '``ParTraversable<'Functor<'T>>``) = (^``ParTraversable<'Functor<'T>>`` : (static member ParSequence : _ -> _) t) : '``Functor<'ParTraversable<'T>>`` [] - static member inline ForInfiniteSequences (t: seq<_>, isFailure, conversion) = + static member inline ForInfiniteSequences (t: seq<_>, []isFailure, []conversion, []result) = let add x y = y :: x let mutable go = true let mutable r = Unchecked.defaultof<_> @@ -265,7 +265,7 @@ type ParSequence = if isEmpty then r <- Map.Invoke List.singleton e.Current else r <- Map.Invoke add r e.Current isEmpty <- false - if isEmpty then ParReturn.Invoke (conversion []) + if isEmpty then result (conversion []) else Map.Invoke (List.rev >> conversion) r type ParTraverse = @@ -306,14 +306,14 @@ type ParTraverse = Traces.add "ParTraverse seq, 'T -> Functor<'U>" #endif let mapped = Seq.map f t - ParSequence.ForInfiniteSequences (mapped, IsParLeftZero.Invoke, List.toSeq) : '``Functor>`` + ParSequence.ForInfiniteSequences (mapped, IsParLeftZero.Invoke, List.toSeq, ParReturn.Invoke) : '``Functor>`` static member inline ParTraverse (t: NonEmptySeq<'T>, f: 'T -> '``Functor<'U>``, []_output: '``Functor>``, []_impl: Default2) = #if TEST_TRACE Traces.add "ParTraverse NonEmptySeq, 'T -> Functor<'U>" #endif let mapped = NonEmptySeq.map f t - ParSequence.ForInfiniteSequences (mapped, IsParLeftZero.Invoke, NonEmptySeq.ofList) : '``Functor>`` + ParSequence.ForInfiniteSequences (mapped, IsParLeftZero.Invoke, NonEmptySeq.ofList, ParReturn.Invoke) : '``Functor>`` static member inline ParTraverse (t: ^a, f, []_output: 'R, []_impl: Default1) : 'R = #if TEST_TRACE @@ -429,7 +429,7 @@ type ParSequence with Seq.foldBack cons_f t (ParReturn.Invoke Seq.empty) static member inline ParSequence (t: seq<'``Applicative<'T>``>, []_output: '``Applicative>`` , []_impl: Default4) : '``Applicative>`` = - ParSequence.ForInfiniteSequences (t, IsParLeftZero.Invoke, List.toSeq) + ParSequence.ForInfiniteSequences (t, IsParLeftZero.Invoke, List.toSeq, ParReturn.Invoke) static member ParSequence (t: seq> , []_output: option> , []_impl: Default3) : option> = Option.Sequence t #if !FABLE_COMPILER @@ -437,18 +437,17 @@ type ParSequence with #endif static member inline ParSequence (t: seq>, []_output: Result, 'e>, []_impl: Default3) : Result, 'e> = Result.Parallel ((++), t) static member inline ParSequence (t: seq>, []_output: Choice, 'e>, []_impl: Default3) : Choice, 'e> = Choice.Parallel ((++), t) - static member ParSequence (t: seq> , []_output: list> , []_impl: Default3) : list> = ParSequence.ForInfiniteSequences (t, List.isEmpty, List.toSeq) - // static member ParSequence (t: seq<'t []> , []_output: seq<'t> [] , []_impl: Default3) : seq<'t> [] = ParSequence.ForInfiniteSequences (t, Array.isEmpty, List.toSeq) + static member ParSequence (t: seq> , []_output: list> , []_impl: Default3) : list> = ParSequence.ForInfiniteSequences (t, List.isEmpty, List.toSeq, List.singleton >> List.cycle) #if !FABLE_COMPILER static member ParSequence (t: seq> , []_output: Async> , []_impl: Default3) : Async> = Async.Parallel t |> Async.map Array.toSeq #endif - static member inline ParSequence (t: NonEmptySeq<'``Applicative<'T>``>, []_output: '``Applicative>`` , []_impl: Default4) : '``Applicative>`` = ParSequence.ForInfiniteSequences (t, IsParLeftZero.Invoke, NonEmptySeq.ofList) + static member inline ParSequence (t: NonEmptySeq<'``Applicative<'T>``>, []_output: '``Applicative>``, []_impl: Default4) : '``Applicative>`` = ParSequence.ForInfiniteSequences (t, IsParLeftZero.Invoke, NonEmptySeq.ofList, fun _ -> Unchecked.defaultof<_>) static member ParSequence (t: NonEmptySeq> , []_output: option> , []_impl: Default3) : option> = Option.Sequence t |> Option.map NonEmptySeq.unsafeOfSeq static member inline ParSequence (t: NonEmptySeq>, []_output: Result, 'e>, []_impl: Default3) : Result, 'e> = Result.Parallel ((++), t) |> Result.map NonEmptySeq.unsafeOfSeq static member inline ParSequence (t: NonEmptySeq>, []_output: Choice, 'e>, []_impl: Default3) : Choice, 'e> = Choice.Parallel ((++), t) |> Choice.map NonEmptySeq.unsafeOfSeq - static member ParSequence (t: NonEmptySeq> , []_output: list> , []_impl: Default3) : list> = ParSequence.ForInfiniteSequences(t, List.isEmpty , NonEmptySeq.ofList) - // static member ParSequence (t: NonEmptySeq<'t []> , []_output: NonEmptySeq<'t> [] , []_impl: Default3) : NonEmptySeq<'t> [] = ParSequence.ForInfiniteSequences(t, Array.isEmpty, NonEmptySeq.ofList) + static member ParSequence (t: NonEmptySeq> , []_output: list> , []_impl: Default3) : list> = ParSequence.ForInfiniteSequences (t, List.isEmpty , NonEmptySeq.ofList, fun _ -> Unchecked.defaultof<_>) + static member ParSequence (t: NonEmptySeq<'t []> , []_output: NonEmptySeq<'t> [] , []_impl: Default3) : NonEmptySeq<'t> [] = ParSequence.ForInfiniteSequences (t, Array.isEmpty, NonEmptySeq.ofList, fun _ -> Unchecked.defaultof<_>) #if !FABLE_COMPILER static member ParSequence (t: NonEmptySeq> , []_output: Async> , []_impl: Default3) = Async.Parallel t |> Async.map NonEmptySeq.unsafeOfSeq : Async> #endif @@ -460,7 +459,7 @@ type ParSequence with #if !FABLE_COMPILER static member inline ParSequence (t: voption<_>, []_output: 'R, []_impl: ParSequence) : 'R = match t with ValueSome x -> Map.Invoke ValueSome x | _ -> ParReturn.Invoke ValueNone #endif - static member inline ParSequence (t: list<_> , []_output: 'R, []_impl: ParSequence) : 'R = ParSequence.ForInfiniteSequences(t, IsParLeftZero.Invoke, id) + static member inline ParSequence (t: list<_> , []_output: 'R, []_impl: ParSequence) : 'R = ParSequence.ForInfiniteSequences (t, IsParLeftZero.Invoke, id, ParReturn.Invoke) static member inline ParSequence (t: Map<_,_> , []_output: 'R, []_impl: ParSequence) : 'R = let insert_f k x ys = Map.Invoke (Map.add k) x ys @@ -476,11 +475,11 @@ type ParSequence with | Choice1Of2 a -> Map.Invoke Choice<'T,'Error>.Choice1Of2 a | Choice2Of2 e -> ParReturn.Invoke (Choice<'T,'Error>.Choice2Of2 e) - static member inline ParSequence (t: _ [] , []_output: 'R , []_impl: ParSequence) : 'R = ParSequence.ForInfiniteSequences(t, IsParLeftZero.Invoke, Array.ofList) + static member inline ParSequence (t: _ [] , []_output: 'R , []_impl: ParSequence) : 'R = ParSequence.ForInfiniteSequences (t, IsParLeftZero.Invoke, Array.ofList, ParReturn.Invoke) - static member inline ParSequence (t: Id<'``Functor<'T>``> , []_output: '``Functor>`` , []_impl: ParSequence) : '``Functor>`` = ParTraverse.Invoke id t + static member inline ParSequence (t: Id<'``Functor<'T>``> , []_output: '``Functor>`` , []_impl: ParSequence) : '``Functor>`` = ParTraverse.Invoke id t - static member inline ParSequence (t: ResizeArray<'``Functor<'T>``>, []_output: '``Functor>`` , []_impl: ParSequence) : '``Functor>``= ParTraverse.Invoke id t + static member inline ParSequence (t: ResizeArray<'``Functor<'T>``>, []_output: '``Functor>``, []_impl: ParSequence) : '``Functor>``= ParTraverse.Invoke id t static member inline Invoke (t: '``ParTraversable<'Applicative<'T>>``) : '``Applicative<'ParTraversable<'T>>`` = let inline call_3 (a: ^a, b: ^b, c: ^c) = ((^a or ^b or ^c) : (static member ParSequence : _*_*_ -> _) b, c, a) diff --git a/src/FSharpPlus/Data/NonEmptyList.fs b/src/FSharpPlus/Data/NonEmptyList.fs index ba6fb2578..ad7ae542b 100644 --- a/src/FSharpPlus/Data/NonEmptyList.fs +++ b/src/FSharpPlus/Data/NonEmptyList.fs @@ -148,6 +148,18 @@ module NonEmptyList = /// let inline sequence (source: NonEmptyList<'``Functor<'T>``>) : '``Functor>`` = traverse id source + /// + /// Maps each element of the list to an action, evaluates these actions from left to right, pointwise, and/or in parallel, and collect the results. + /// + let inline ptraverse (f: 'T -> '``Functor<'U>``) (source: NonEmptyList<'T>) = + ParSequence.ForInfiniteSequences (Seq.map f source, IsParLeftZero.Invoke, ofList, fun _ -> invalidOp "Unreacheable code.") + + /// + /// Evaluates each action in the list from left to right, pointwise, and/or in parallel and collect the results. + /// + let inline psequence (source: NonEmptyList<'``Functor<'T>``>) : '``Functor>`` = + ParSequence.ForInfiniteSequences (source, IsParLeftZero.Invoke, ofList, fun _ -> invalidOp "Unreacheable code.") + #endif /// Returns the average of the elements in the list. @@ -251,6 +263,7 @@ type NonEmptyList<'t> with let r = NonEmptyList.toList f NonEmptyList.toList x {Head = r.Head; Tail = r.Tail} + static member ParReturn (x: 'a) = { Head = x; Tail = List.cycle [x] } static member () (f: NonEmptyList<'T->'U>, x: NonEmptyList<'T>) = NonEmptyList.map2Shortest (<|) f x static member Lift2 (f: 'T -> 'U -> 'V, x, y) = NonEmptyList.ofList (List.lift2 f (NonEmptyList.toList x) (NonEmptyList.toList y)) @@ -290,6 +303,12 @@ type NonEmptyList<'t> with [] static member inline Sequence (s: NonEmptyList<'``Functor<'T>``>) : '``Functor>`` = NonEmptyList.sequence s + [] + static member inline ParTraverse (s: NonEmptyList<'T>, f: 'T -> '``Functor<'U>``) : '``Functor>`` = NonEmptyList.ptraverse f s + + [] + static member inline ParSequence (s: NonEmptyList<'``Functor<'T>``>) : '``Functor>`` = NonEmptyList.psequence s + static member Replace (source: NonEmptyList<'T>, oldValue: NonEmptyList<'T>, newValue: NonEmptyList<'T>, _impl: Replace ) = let lst = source |> NonEmptyList.toSeq |> Seq.replace oldValue newValue |> Seq.toList {Head = lst.Head; Tail = lst.Tail} From 29d3ff3b437175e6e1d48f9c4a97f3629fe49a17 Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Mon, 22 Jan 2024 08:31:20 +0100 Subject: [PATCH 18/27] Align code --- src/FSharpPlus/Control/Parallel.fs | 9 ++++----- src/FSharpPlus/Extensions/Extensions.fs | 2 +- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/src/FSharpPlus/Control/Parallel.fs b/src/FSharpPlus/Control/Parallel.fs index 66d90911b..982962363 100644 --- a/src/FSharpPlus/Control/Parallel.fs +++ b/src/FSharpPlus/Control/Parallel.fs @@ -45,8 +45,8 @@ type ParReturn = static member inline ParReturn (x: 'm * 'a , _: ParReturn) = Return.Return (x, Unchecked.defaultof) static member inline ParReturn (x: struct ('m * 'a), _: ParReturn) = Return.Return (x, Unchecked.defaultof) static member ParReturn (_: 'a Async , _: ParReturn) = fun (x: 'a) -> async.Return x - static member inline ParReturn (_: Result<'t, 'e> , _: ParReturn) = fun x -> if opaqueId false then Error (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e> : 'e) else Ok x : Result<'t,'e> - static member inline ParReturn (_: Choice<'t, 'e> , _: ParReturn) = fun x -> if opaqueId false then Choice2Of2 (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e> : 'e) else Choice1Of2 x : Choice<'t,'e> + static member inline ParReturn (_: Result<'t, 'e> , _: ParReturn) = fun x -> if opaqueId false then Error (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e>) else Ok x : Result<'t, 'e> + static member inline ParReturn (_: Choice<'t, 'e> , _: ParReturn) = fun x -> if opaqueId false then Choice2Of2 (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e>) else Choice1Of2 x : Choice<'t, 'e> #if !FABLE_COMPILER static member ParReturn (x: Expr<'a> , _: ParReturn) = Return.Return (x, Unchecked.defaultof) #endif @@ -120,7 +120,6 @@ type ParApply = #if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 type ParApply with - static member inline ```` (struct (_: ^t when ^t : null and ^t: struct, _: ^u when ^u : null and ^u: struct), _output: ^r when ^r : null and ^r: struct, _mthd: Default1) = id static member inline ```` (struct (f: '``Applicative<'T->'U>``, x: '``Applicative<'T>``), _output: '``Applicative<'U>``, []_mthd: Default1) : '``Applicative<'U>`` = ((^``Applicative<'T->'U>`` or ^``Applicative<'T>`` or ^``Applicative<'U>``) : (static member () : _*_ -> _) f, x) @@ -137,7 +136,7 @@ type ParLift2 = static member ParLift2 (f, (x: _ [] , y: _ [] ), _mthd: ParLift2) = Array.map2Shortest f x y static member ParLift2 (f, (x: 'R -> 'T , y: 'R -> 'U ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) static member inline ParLift2 (f, (x: 'Monoid * 'T , y: 'Monoid * 'U ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) - static member inline ParLift2 (f, (x: struct ('Monoid * 'T), y: struct ('Monoid * 'U)), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member inline ParLift2 (f, (x: struct ('Monoid*'T), y: struct ('Monoid*'U)), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) #if !FABLE_COMPILER static member ParLift2 (f, (x: Task<'T> , y: Task<'U> ), _mthd: ParLift2) = Task.pmap2 f x y #endif @@ -184,7 +183,7 @@ type ParLift3 = static member ParLift3 (f, (x: _ [] , y: _ [] , z: _ [] ), _mthd: ParLift3) = Array.map3Shortest f x y z static member ParLift3 (f, (x: 'R -> 'T , y: 'R -> 'U , z: 'R -> 'V ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) static member inline ParLift3 (f, (x: 'Monoid * 'T , y: 'Monoid * 'U , z: 'Monoid * 'V ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) - static member inline ParLift3 (f, (x: struct ('Monoid * 'T), y: struct ('Monoid * 'U), z: struct ('Monoid * 'T)), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member inline ParLift3 (f, (x: struct ('Monoid*'T), y: struct ('Monoid*'U), z: struct ('Monoid* 'T)), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) #if !FABLE_COMPILER static member ParLift3 (f, (x: Task<'T> , y: Task<'U> , z: Task<'V> ), _mthd: ParLift3) = Task.pmap3 f x y z #endif diff --git a/src/FSharpPlus/Extensions/Extensions.fs b/src/FSharpPlus/Extensions/Extensions.fs index d34a8fc97..59af7fc4d 100644 --- a/src/FSharpPlus/Extensions/Extensions.fs +++ b/src/FSharpPlus/Extensions/Extensions.fs @@ -207,7 +207,7 @@ module Extensions = | ValueNone -> Choice1Of2 (accumulator.Close () |> Array.toSeq) | ValueSome x -> Choice2Of2 x #endif - + /// Returns all Errors combined, otherwise a sequence of all elements. static member Parallel (combiner, t: seq>) = let mutable error = ValueNone From 14578f0e136da5fe99af1291f6cacc4cfe2fd2bb Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Wed, 24 Jan 2024 12:25:58 +0100 Subject: [PATCH 19/27] New naming convention --- ...ive.fsx => abstraction-zipapplicative.fsx} | 47 ++-- src/FSharpPlus/Builders.fs | 34 +-- src/FSharpPlus/Control/Applicative.fs | 12 +- src/FSharpPlus/Control/Functor.fs | 6 +- src/FSharpPlus/Control/MonadOps.fs | 4 +- src/FSharpPlus/Control/Monoid.fs | 6 +- src/FSharpPlus/Control/Parallel.fs | 254 ------------------ src/FSharpPlus/Control/Traversable.fs | 200 +++++++------- src/FSharpPlus/Control/ZipApplicative.fs | 254 ++++++++++++++++++ src/FSharpPlus/Data/Monoids.fs | 14 +- src/FSharpPlus/Data/NonEmptyList.fs | 24 +- src/FSharpPlus/Extensions/Async.fs | 36 ++- src/FSharpPlus/Extensions/Task.fs | 21 +- src/FSharpPlus/Extensions/ValueTask.fs | 24 +- src/FSharpPlus/FSharpPlus.fsproj | 2 +- src/FSharpPlus/Math/Applicative.fs | 28 +- src/FSharpPlus/Operators.fs | 28 +- tests/FSharpPlus.Tests/Applicatives.fs | 12 +- tests/FSharpPlus.Tests/Extensions.fs | 4 +- tests/FSharpPlus.Tests/Task.fs | 32 +-- 20 files changed, 539 insertions(+), 503 deletions(-) rename docsrc/content/{abstraction-par-applicative.fsx => abstraction-zipapplicative.fsx} (58%) delete mode 100644 src/FSharpPlus/Control/Parallel.fs create mode 100644 src/FSharpPlus/Control/ZipApplicative.fs diff --git a/docsrc/content/abstraction-par-applicative.fsx b/docsrc/content/abstraction-zipapplicative.fsx similarity index 58% rename from docsrc/content/abstraction-par-applicative.fsx rename to docsrc/content/abstraction-zipapplicative.fsx index 74bfb7159..9960006e6 100644 --- a/docsrc/content/abstraction-par-applicative.fsx +++ b/docsrc/content/abstraction-zipapplicative.fsx @@ -4,37 +4,42 @@ #r @"../../src/FSharpPlus/bin/Release/netstandard2.0/FSharpPlus.dll" (** -Par-Applicative -=============== -A functor with application, providing operations to embed pure expressions (``preturn``), parallel computations and combine their results (````). +ZipApplicative +============== +A functor with application, providing operations to embed pure expressions (``pur``), run computations pointwise and/or paralell and combine their results (``<.>``). ___ Minimal complete definition --------------------------- - * ``preturn x``   /   ``result x`` - * ``() f x`` + * ``pur x``   .   ``result x`` + * ``(<.>) f x`` *) (** - static member ParReturn (x: 'T) : 'Applicative<'T> - static member () (f: 'Applicative<'T -> 'U>, x: 'Applicative<'T>) : 'Applicative<'U> + static member Pure (x: 'T) : 'ZipApplicative<'T> + static member (<.>) (f: 'ZipApplicative<'T -> 'U>, x: 'ZipApplicative<'T>) : 'ZipApplicative<'U> *) (** -Note: ``preturn`` can't be used outside computation expressions, use ``result`` instead. Other operations ---------------- -* ``plift2`` +* ``zip`` *) (** - static member ParLift2 (f: 'T1 -> 'T2 -> 'T, x1: 'Applicative<'T1>, x2: 'Applicative<'T2>) : 'Applicative<'T> + static member Zip (x1: 'ZipApplicative<'T1>, x2: 'ZipApplicative<'T2>) : 'ZipApplicative<'T1 * 'T2> +*) +(** +* ``map2`` +*) +(** + static member Map2 (f: 'T1 -> 'T2 -> 'T, x1: 'ZipApplicative<'T1>, x2: 'ZipApplicative<'T2>) : 'ZipApplicative<'T> *) (** -* ``plift3`` +* ``map3`` *) (** - static member ParLift3 (f: 'T1 -> 'T2 -> 'T3 -> 'T, x1: 'Applicative<'T1>, x2: 'Applicative<'T2>, x3: 'Applicative<'T3>) : 'Applicative<'T> + static member Map3 (f: 'T1 -> 'T2 -> 'T3 -> 'T, x1: 'ZipApplicative<'T1>, x2: 'ZipApplicative<'T2>, x3: 'ZipApplicative<'T3>) : 'ZipApplicative<'T> *) (** @@ -44,17 +49,17 @@ Rules ----- *) (** - presult id v = v - presult (<<) u v w = u (v w) - presult f <*> presult x = presult (f x) - u <*> presult y = presult ((|>) y) u + pur id <.> v = v + pur (<<) <.> u <.> v <.> w = u <.> (v <.> w) + pur f <*> pur x = pur (f x) + u <*> pur y = pur ((|>) y) <.> u *) (** Related Abstractions -------------------- - - [Functor](abstraction-functor.html): A parallel applicative is a functor whose ``map`` operation can be splitted in ``preturn`` and ``()`` operations, + - [Functor](abstraction-functor.html): A zipApplicative is a functor whose ``map`` operation can be splitted in ``pur`` and ``(<.>)`` operations, - - [Applicative](abstraction-applicative.html) : Parallel Applicatives are applicatives which usually don't form a [Monad](abstraction-monad.html). + - [ZipApplicative](abstraction-applicative.html) : ZipApplicatives are applicatives which usually don't form a [Monad](abstraction-monad.html). Concrete implementations ------------------------ @@ -81,7 +86,7 @@ From F#+ - [``NonEmptySeq<'T>``] - [``NonEmptyList<'T>``](type-nonempty.html) - - [``Compose<'Applicative1<'Applicative2<'T>>>``](type-compose.html) + - [``Compose<'ZipApplicative1<'ZipApplicative2<'T>>>``](type-compose.html) (*) The operation is the same as that for the normal applicative @@ -114,7 +119,7 @@ open FSharpPlus // pointwise operations let arr1 = (+) [|1;2;3|] <*> [|10;20;30|] -let arr2 = (+) [|1;2;3|] [|10;20;30|] +let arr2 = (+) [|1;2;3|] <.> [|10;20;30|] // val arr1: int array = [|11; 21; 31; 12; 22; 32; 13; 23; 33|] // val arr2: int array = [|11; 22; 33|] @@ -122,7 +127,7 @@ let arr2 = (+) [|1;2;3|] [|10;20;30|] // Validations -let validated = par2 { +let validated = zapp2 { let! x = async { return Ok 1 } and! y = async { return Ok 2 } and! z = async { return Error ["Error"] } diff --git a/src/FSharpPlus/Builders.fs b/src/FSharpPlus/Builders.fs index cda39583c..47cce06ed 100644 --- a/src/FSharpPlus/Builders.fs +++ b/src/FSharpPlus/Builders.fs @@ -210,24 +210,24 @@ module GenericBuilders = member _.Run x : '``Applicative1>>`` = x - /// Generic Parallel Applicative CE builder. - type ParallelBuilder<'``applicative<'t>``> () = + /// Generic ZipApplicative CE builder. + type ZipApplicativeBuilder<'``applicative<'t>``> () = member _.ReturnFrom (expr) = expr : '``applicative<'t>`` - member inline _.Return (x: 'T) = ParReturn.Invoke x : '``Applicative<'T>`` - member inline _.Yield (x: 'T) = ParReturn.Invoke x : '``Applicative<'T>`` + member inline _.Return (x: 'T) = pur x : '``Applicative<'T>`` + member inline _.Yield (x: 'T) = pur x : '``Applicative<'T>`` member inline _.BindReturn(x, []f) = map f x : '``Applicative<'U>`` - member inline _.MergeSources (t1: '``Applicative<'T>``, t2: '``Applicative<'U>``) : '``Applicative<'T * 'U>`` = ParLift2.Invoke tuple2 t1 t2 - member inline _.MergeSources3 (t1: '``Applicative<'T>``, t2: '``Applicative<'U>``, t3: '``Applicative<'V>``) : '``Applicative<'T * 'U * 'V>`` = ParLift3.Invoke tuple3 t1 t2 t3 - member _.Run f = f : '``Applicative<'T>`` + member inline _.MergeSources (t1: '``Applicative<'T>``, t2: '``Applicative<'U>``) : '``Applicative<'T * 'U>`` = map2 tuple2 t1 t2 + member inline _.MergeSources3 (t1: '``Applicative<'T>``, t2: '``Applicative<'U>``, t3: '``Applicative<'V>``) : '``Applicative<'T * 'U * 'V>`` = map3 tuple3 t1 t2 t3 + member _.Run f : '``Applicative<'T>`` = f - /// Generic 2 layers Parallel Applicative CE builder. - type ParallelBuilder2<'``applicative1>``> () = + /// Generic 2 layers ZipApplicative CE builder. + type ZipApplicativeBuilder2<'``applicative1>``> () = member _.ReturnFrom expr : '``applicative1>`` = expr - member inline _.Return (x: 'T) : '``Applicative1>`` = (presult >> presult) x - member inline _.Yield (x: 'T) : '``Applicative1>`` = (presult >> presult) x + member inline _.Return (x: 'T) : '``Applicative1>`` = (pur >> pur) x + member inline _.Yield (x: 'T) : '``Applicative1>`` = (pur >> pur) x member inline _.BindReturn (x: '``Applicative1>``, []f: _ -> _) : '``Applicative1>`` = (map >> map) f x - member inline _.MergeSources (t1, t2) : '``Applicative1>`` = (plift2 >> plift2) tuple2 t1 t2 - member inline _.MergeSources3 (t1, t2, t3) : '``Applicative1>`` = (plift3 >> plift3) tuple3 t1 t2 t3 + member inline _.MergeSources (t1, t2) : '``Applicative1>`` = (map2 >> map2) tuple2 t1 t2 + member inline _.MergeSources3 (t1, t2, t3) : '``Applicative1>`` = (map3 >> map3) tuple3 t1 t2 t3 member _.Run x : '``Applicative1>`` = x /// Creates a (lazy) monadic computation expression with side-effects (see http://fsprojects.github.io/FSharpPlus/computation-expressions.html for more information) @@ -245,10 +245,10 @@ module GenericBuilders = /// Creates an applicative computation expression which compose effects of three Applicatives. let applicative3<'``Applicative1>>``> = ApplicativeBuilder3<'``Applicative1>>``> () - /// Creates a parallel applicative computation expression. - let par<'``Applicative<'T>``> = ParallelBuilder<'``Applicative<'T>``> () + /// Creates a (non sequential) applicative computation expression. + let zapp<'``Applicative<'T>``> = ZipApplicativeBuilder<'``Applicative<'T>``> () - /// Creates a parallel applicative computation expression which compose effects of two Applicatives. - let par2<'``Applicative1>``> = ParallelBuilder2<'``Applicative1>``> () + /// Creates a (non sequential) applicative computation expression which compose effects of two Applicatives. + let zapp2<'``Applicative1>``> = ZipApplicativeBuilder2<'``Applicative1>``> () #endif diff --git a/src/FSharpPlus/Control/Applicative.fs b/src/FSharpPlus/Control/Applicative.fs index 54675adcd..11f5aeb8d 100644 --- a/src/FSharpPlus/Control/Applicative.fs +++ b/src/FSharpPlus/Control/Applicative.fs @@ -109,12 +109,12 @@ type Lift2 = static member inline Lift2 (f, ((a: 'Monoid, x: 'T) , (b: 'Monoid, y: 'U) ), _mthd: Lift2) = Plus.Invoke a b, f x y static member inline Lift2 (f, (struct (a: 'Monoid, x: 'T), struct (b: 'Monoid, y: 'U)), _mthd: Lift2) = struct (Plus.Invoke a b, f x y) #if !FABLE_COMPILER - static member Lift2 (f, (x: Task<'T> , y: Task<'U> ), _mthd: Lift2) = Task.map2 f x y + static member Lift2 (f, (x: Task<'T> , y: Task<'U> ), _mthd: Lift2) = Task.lift2 f x y #endif #if !NET45 && !NETSTANDARD2_0 && !FABLE_COMPILER - static member Lift2 (f, (x: ValueTask<'T> , y: ValueTask<'U> ), _mthd: Lift2) = ValueTask.map2 f x y + static member Lift2 (f, (x: ValueTask<'T> , y: ValueTask<'U> ), _mthd: Lift2) = ValueTask.lift2 f x y #endif - static member Lift2 (f, (x , y ), _mthd: Lift2) = Async.map2 f x y + static member Lift2 (f, (x , y ), _mthd: Lift2) = Async.lift2 f x y static member Lift2 (f, (x , y ), _mthd: Lift2) = Option.map2 f x y #if !FABLE_COMPILER @@ -158,12 +158,12 @@ type Lift3 = static member inline Lift3 (f, ((a: 'Monoid, x: 'T) , (b: 'Monoid, y: 'U) , (c: 'Monoid, z: 'U) ), _mthd: Lift3) = Plus.Invoke (Plus.Invoke a b) c, f x y z static member inline Lift3 (f, (struct (a: 'Monoid, x: 'T), struct (b: 'Monoid, y: 'U), struct (c: 'Monoid, z: 'U)), _mthd: Lift3) = struct (Plus.Invoke (Plus.Invoke a b) c, f x y z) #if !FABLE_COMPILER - static member Lift3 (f, (x: Task<'T> , y: Task<'U> , z: Task<'V> ), _mthd: Lift3) = Task.map3 f x y z + static member Lift3 (f, (x: Task<'T> , y: Task<'U> , z: Task<'V> ), _mthd: Lift3) = Task.lift3 f x y z #endif #if !NET45 && !NETSTANDARD2_0 && !FABLE_COMPILER - static member Lift3 (f, (x: ValueTask<'T> , y: ValueTask<'U> , z: ValueTask<'V> ), _mthd: Lift3) = ValueTask.map3 f x y z + static member Lift3 (f, (x: ValueTask<'T> , y: ValueTask<'U> , z: ValueTask<'V> ), _mthd: Lift3) = ValueTask.lift3 f x y z #endif - static member Lift3 (f, (x , y , z ), _mthd: Lift3) = Async.map3 f x y z + static member Lift3 (f, (x , y , z ), _mthd: Lift3) = Async.lift3 f x y z static member Lift3 (f, (x , y , z ), _mthd: Lift3) = Option.map3 f x y z #if !FABLE_COMPILER diff --git a/src/FSharpPlus/Control/Functor.fs b/src/FSharpPlus/Control/Functor.fs index 2058fd069..f33218683 100644 --- a/src/FSharpPlus/Control/Functor.fs +++ b/src/FSharpPlus/Control/Functor.fs @@ -219,12 +219,12 @@ type Zip = static member Zip ((x: option<'T> , y: option<'U> , _output: option<'T*'U> ), _mthd: Zip) = Option.zip x y static member Zip ((x: voption<'T> , y: voption<'U> , _output: voption<'T*'U> ), _mthd: Zip) = ValueOption.zip x y static member Zip ((x: Result<'T, 'Error> , y: Result<'U, 'Error> , _output: Result<'T * 'U, 'Error> ), _mthd: Zip) = Result.zip x y - static member Zip ((x: Async<'T> , y: Async<'U> , _output: Async<'T*'U> ), _mthd: Zip) = Async.zip x y + static member Zip ((x: Async<'T> , y: Async<'U> , _output: Async<'T*'U> ), _mthd: Zip) = Async.zipSequentially x y #if !FABLE_COMPILER - static member Zip ((x: Task<'T> , y: Task<'U> , _output: Task<'T*'U> ), _mthd: Zip) = Task.zip x y + static member Zip ((x: Task<'T> , y: Task<'U> , _output: Task<'T*'U> ), _mthd: Zip) = Task.zipSequentially x y #endif #if !NET45 && !NETSTANDARD2_0 && !FABLE_COMPILER - static member Zip ((x: ValueTask<'T> , y: ValueTask<'U> , _output: ValueTask<'T*'U> ), _mthd: Zip) = ValueTask.zip x y + static member Zip ((x: ValueTask<'T> , y: ValueTask<'U> , _output: ValueTask<'T*'U> ), _mthd: Zip) = ValueTask.zipSequentially x y #endif static member inline Invoke (source1: '``ZipFunctor<'T1>``) (source2: '``ZipFunctor<'T2>``) = diff --git a/src/FSharpPlus/Control/MonadOps.fs b/src/FSharpPlus/Control/MonadOps.fs index ae972a90d..f7e1b7059 100644 --- a/src/FSharpPlus/Control/MonadOps.fs +++ b/src/FSharpPlus/Control/MonadOps.fs @@ -8,8 +8,8 @@ module internal MonadOps = let inline (>>=) x f = Bind.Invoke x f let inline result x = Return.Invoke x let inline (<*>) f x = Apply.Invoke f x - let inline presult x = ParReturn.Invoke x - let inline () f x = ParApply.Invoke f x + let inline pur x = Pure.Invoke x + let inline (<.>) f x = ZipApply.Invoke f x let inline (<|>) x y = Append.Invoke x y let inline (>=>) (f: 'a->'``Monad<'b>``) (g: 'b->'``Monad<'c>``) (x: 'a) : '``Monad<'c>`` = f x >>= g diff --git a/src/FSharpPlus/Control/Monoid.fs b/src/FSharpPlus/Control/Monoid.fs index a4aaa8126..2c855d3b4 100644 --- a/src/FSharpPlus/Control/Monoid.fs +++ b/src/FSharpPlus/Control/Monoid.fs @@ -116,13 +116,13 @@ type Plus with #if !FABLE_COMPILER type Plus with - static member inline ``+`` (x: 'a Task, y: 'a Task, []_mthd: Plus) = Task.map2 Plus.Invoke x y + static member inline ``+`` (x: 'a Task, y: 'a Task, []_mthd: Plus) = Task.lift2 Plus.Invoke x y #endif #if !NET45 && !NETSTANDARD2_0 && !FABLE_COMPILER type Plus with - static member inline ``+`` (x: 'a ValueTask, y: 'a ValueTask, []_mthd: Plus) = ValueTask.map2 Plus.Invoke x y + static member inline ``+`` (x: 'a ValueTask, y: 'a ValueTask, []_mthd: Plus) = ValueTask.lift2 Plus.Invoke x y #endif @@ -138,7 +138,7 @@ type Plus with static member inline ``+`` (f: 'T->'Monoid, g: 'T->'Monoid, []_mthd: Plus) = (fun x -> Plus.Invoke (f x) (g x)) : 'T->'Monoid - static member inline ``+`` (x: 'S Async , y: 'S Async , []_mthd: Plus) = Async.map2 Plus.Invoke x y + static member inline ``+`` (x: 'S Async , y: 'S Async , []_mthd: Plus) = Async.lift2 Plus.Invoke x y static member inline ``+`` (x: 'a Expr , y: 'a Expr , []_mthd: Plus) : 'a Expr = let inline f (x: 'a) : 'a -> 'a = Plus.Invoke x diff --git a/src/FSharpPlus/Control/Parallel.fs b/src/FSharpPlus/Control/Parallel.fs deleted file mode 100644 index 982962363..000000000 --- a/src/FSharpPlus/Control/Parallel.fs +++ /dev/null @@ -1,254 +0,0 @@ -namespace FSharpPlus.Control - -open System -open System.Text -open System.Runtime.InteropServices -open System.Collections.Generic -open System.Threading.Tasks -open Microsoft.FSharp.Quotations - -open FSharpPlus.Internals -open FSharpPlus.Internals.Prelude -open FSharpPlus -open FSharpPlus.Data - - -type ParReturn = - inherit Default1 - static member inline InvokeOnInstance (x: 'T) = (^``ParApplicative<'T>`` : (static member ParReturn : ^T -> ^``ParApplicative<'T>``) x) - -#if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 - - static member inline Invoke (x: 'T) : '``ParApplicative<'T>`` = - let inline call (mthd: ^M, output: ^R) = ((^M or ^R) : (static member ParReturn : _*_ -> _) output, mthd) - call (Unchecked.defaultof, Unchecked.defaultof<'``ParApplicative<'T>``>) x - - static member ParReturn (_: seq<'a> , _: Default2 ) = fun x -> Seq.initInfinite (fun _ -> x) : seq<'a> - static member ParReturn (_: NonEmptySeq<'a> , _: Default2 ) = fun x -> NonEmptySeq.initInfinite (fun _ -> x) : NonEmptySeq<'a> - static member ParReturn (_: IEnumerator<'a> , _: Default2 ) = fun x -> Enumerator.upto None (fun _ -> x) : IEnumerator<'a> - static member inline ParReturn (_: 'R , _: Default1 ) = fun (x: 'T) -> ParReturn.InvokeOnInstance x : 'R - static member ParReturn (x: Lazy<'a> , _: ParReturn) = Return.Return (x, Unchecked.defaultof) : _ -> Lazy<'a> - #if !FABLE_COMPILER - static member ParReturn (_: 'T Task , _: ParReturn) = fun x -> Task.FromResult x : 'T Task - #endif - #if NETSTANDARD2_1 && !FABLE_COMPILER - static member ParReturn (_: 'T ValueTask , _: ParReturn) = fun (x: 'T) -> ValueTask<'T> x : 'T ValueTask - #endif - static member ParReturn (x: option<'a> , _: ParReturn) = Return.Return (x, Unchecked.defaultof) - static member ParReturn (x: voption<'a> , _: ParReturn) = Return.Return (x, Unchecked.defaultof) - static member ParReturn (_: list<'a> , _: ParReturn) = fun x -> List.cycle [x] : list<'a> - - [] - static member ParReturn (x: 'a [] , _: ParReturn) = Return.Return (x, Unchecked.defaultof) - - static member ParReturn (x: 'r -> 'a , _: ParReturn) = Return.Return (x, Unchecked.defaultof) - static member inline ParReturn (x: 'm * 'a , _: ParReturn) = Return.Return (x, Unchecked.defaultof) - static member inline ParReturn (x: struct ('m * 'a), _: ParReturn) = Return.Return (x, Unchecked.defaultof) - static member ParReturn (_: 'a Async , _: ParReturn) = fun (x: 'a) -> async.Return x - static member inline ParReturn (_: Result<'t, 'e> , _: ParReturn) = fun x -> if opaqueId false then Error (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e>) else Ok x : Result<'t, 'e> - static member inline ParReturn (_: Choice<'t, 'e> , _: ParReturn) = fun x -> if opaqueId false then Choice2Of2 (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e>) else Choice1Of2 x : Choice<'t, 'e> - #if !FABLE_COMPILER - static member ParReturn (x: Expr<'a> , _: ParReturn) = Return.Return (x, Unchecked.defaultof) - #endif - - [", 10720, IsError = true)>] - static member ParReturn (x: ResizeArray<'a>, _: ParReturn ) = Return.Return (x, Unchecked.defaultof) - - //Restricted - [] - static member ParReturn (_: string , _: ParReturn ) = fun (x: char) -> string x : string - [] - static member ParReturn (_: StringBuilder , _: ParReturn ) = fun (x: char) -> new StringBuilder (string x) : StringBuilder - [] - static member ParReturn (_: 'a Set , _: ParReturn ) = fun (x: 'a ) -> Set.singleton x - static member ParReturn (_: 'a Set2 , _: ParReturn ) = fun (_: 'a ) -> Set2() : 'a Set2 - -#endif - -type ParApply = - inherit Default1 - -#if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 - - static member ```` (struct (f: Lazy<'T->'U> , x: Lazy<'T> ), []_output: Lazy<'U> , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - static member ```` (struct (f: seq<_> , x: seq<'T> ), []_output: seq<'U> , []_mthd: ParApply) = Seq.map2 (<|) f x - static member ```` (struct (f: NonEmptySeq<_> , x: NonEmptySeq<'T> ), []_output: NonEmptySeq<'U> , []_mthd: ParApply) = NonEmptySeq.map2 (<|) f x - static member ```` (struct (f: IEnumerator<_> , x: IEnumerator<'T> ), []_output: IEnumerator<'U> , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - static member ```` (struct (f: list<_> , x: list<'T> ), []_output: list<'U> , []_mthd: ParApply) = List.map2Shortest (<|) f x - static member ```` (struct (f: _ [] , x: 'T [] ), []_output: 'U [] , []_mthd: ParApply) = Array.map2Shortest (<|) f x - static member ```` (struct (f: 'r -> _ , x: _ -> 'T ), []_output: 'r -> 'U , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - static member inline ```` (struct (f: 'Monoid * _ , x: ('Monoid * 'T) ), []_output: 'Monoid * 'U , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - static member inline ```` (struct (f: struct ('Monoid * _), x: struct ('Monoid * 'T)), []_output: struct ('Monoid * 'U), []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - #if !FABLE_COMPILER - static member ```` (struct (f: Task<_> , x: Task<'T> ), []_output: Task<'U> , []_mthd: ParApply) = Task.pmap2 (<|) f x - #endif - #if !NET45 && !NETSTANDARD2_0 && !FABLE_COMPILER - static member ```` (struct (f: ValueTask<_> , x: ValueTask<'T> ), []_output: ValueTask<'U> , []_mthd: ParApply) = ValueTask.pmap2 (<|) f x - #endif - static member ```` (struct (f: Async<_> , x: Async<'T> ), []_output: Async<'U> , []_mthd: ParApply) : Async<'U> = Async.pmap2 (<|) f x - static member ```` (struct (f: option<_> , x: option<'T> ), []_output: option<'U> , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - static member ```` (struct (f: voption<_> , x: voption<'T> ), []_output: voption<'U> , []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - static member inline ```` (struct (f: Result<_,'E> , x: Result<'T,'E> ), []_output: Result<'b,'E> , []_mthd: ParApply) : Result<'U, 'E> = Result.apply2With Plus.Invoke (<|) f x - static member inline ```` (struct (f: Choice<_,'E> , x: Choice<'T,'E> ), []_output: Choice<'b,'E> , []_mthd: ParApply) : Choice<'U, 'E> = Choice.apply2With Plus.Invoke (<|) f x - static member inline ```` (struct (f: KeyValuePair<'Key,_>, x: KeyValuePair<'Key,'T>), []_output: KeyValuePair<'Key,'U>, []_mthd: Default2) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - static member inline ```` (struct (f: KeyValuePair2<_,_>, x: KeyValuePair2<_,'T> ) , _output: KeyValuePair2<_,'U> , _mthd: Default2) : KeyValuePair2<'Key,'U> = - let a, b = f.Key, x.Key - let f, x = f.Value, x.Value - KeyValuePair2 (Plus.Invoke a b, f x) - - - static member ```` (struct (f: Map<'Key,_> , x: Map<'Key,'T> ), []_output: Map<'Key,'U> , []_mthd: ParApply) : Map<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - static member ```` (struct (f: Dictionary<'Key,_> , x: Dictionary<'Key,'T> ), []_output: Dictionary<'Key,'U> , []_mthd: ParApply) : Dictionary<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - static member ```` (struct (f: IDictionary<'Key,_> , x: IDictionary<'Key,'T> ), []_output: IDictionary<'Key,'U> , []_mthd: ParApply) : IDictionary<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - static member ```` (struct (f: IReadOnlyDictionary<'Key,_>, x: IReadOnlyDictionary<'Key,'T> ), []_output: IReadOnlyDictionary<'Key,'U>, []_mthd: ParApply) : IReadOnlyDictionary<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - - #if !FABLE_COMPILER - static member ```` (struct (f: Expr<'T->'U>, x: Expr<'T>), []_output: Expr<'U>, []_mthd: ParApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) - #endif - static member ```` (struct (f: ('T->'U) ResizeArray, x: 'T ResizeArray), []_output: 'U ResizeArray, []_mthd: ParApply) = ResizeArray.map2Shortest (<|) f x - - static member inline Invoke (f: '``ParApplicative<'T -> 'U>``) (x: '``ParApplicative<'T>``) : '``ParApplicative<'U>`` = - let inline call (mthd: ^M, input1: ^I1, input2: ^I2, output: ^R) = - ((^M or ^I1 or ^I2 or ^R) : (static member ```` : struct (_*_) * _ * _ -> _) (struct (input1, input2)), output, mthd) - call(Unchecked.defaultof, f, x, Unchecked.defaultof<'``ParApplicative<'U>``>) - -#endif - - static member inline InvokeOnInstance (f: '``ParApplicative<'T->'U>``) (x: '``ParApplicative<'T>``) : '``ParApplicative<'U>`` = - ((^``ParApplicative<'T->'U>`` or ^``ParApplicative<'T>`` or ^``ParApplicative<'U>``) : (static member () : _*_ -> _) (f, x)) - -#if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 - -type ParApply with - static member inline ```` (struct (_: ^t when ^t : null and ^t: struct, _: ^u when ^u : null and ^u: struct), _output: ^r when ^r : null and ^r: struct, _mthd: Default1) = id - static member inline ```` (struct (f: '``Applicative<'T->'U>``, x: '``Applicative<'T>``), _output: '``Applicative<'U>``, []_mthd: Default1) : '``Applicative<'U>`` = - ((^``Applicative<'T->'U>`` or ^``Applicative<'T>`` or ^``Applicative<'U>``) : (static member () : _*_ -> _) f, x) - - -type ParLift2 = - inherit Default1 - - static member ParLift2 (f, (x: Lazy<_> , y: Lazy<_> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) - static member ParLift2 (f, (x: seq<_> , y: seq<_> ), _mthd: ParLift2) = Seq.map2 f x y - static member ParLift2 (f, (x: NonEmptySeq<_> , y: NonEmptySeq<_> ), _mthd: ParLift2) = NonEmptySeq.map2 f x y - static member ParLift2 (f, (x: IEnumerator<_> , y: IEnumerator<_> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) - static member ParLift2 (f, (x , y ), _mthd: ParLift2) = List.map2Shortest f x y - static member ParLift2 (f, (x: _ [] , y: _ [] ), _mthd: ParLift2) = Array.map2Shortest f x y - static member ParLift2 (f, (x: 'R -> 'T , y: 'R -> 'U ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) - static member inline ParLift2 (f, (x: 'Monoid * 'T , y: 'Monoid * 'U ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) - static member inline ParLift2 (f, (x: struct ('Monoid*'T), y: struct ('Monoid*'U)), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) - #if !FABLE_COMPILER - static member ParLift2 (f, (x: Task<'T> , y: Task<'U> ), _mthd: ParLift2) = Task.pmap2 f x y - #endif - #if NETSTANDARD2_1 && !FABLE_COMPILER - static member ParLift2 (f, (x: ValueTask<'T> , y: ValueTask<'U> ), _mthd: ParLift2) = ValueTask.pmap2 f x y - #endif - static member ParLift2 (f, (x , y ), _mthd: ParLift2) = Async.pmap2 f x y - static member ParLift2 (f, (x: option<_> , y: option<_> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) - - #if !FABLE_COMPILER - static member ParLift2 (f, (x: voption<_> , y: voption<_> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) - #endif - static member inline ParLift2 (f, (x: Result<'T,'Error> , y: Result<'U,'Error> ), _mthd: ParLift2) = Result.apply2With Plus.Invoke f x y - static member inline ParLift2 (f, (x: Choice<'T,'Error> , y: Choice<'U,'Error> ), _mthd: ParLift2) = Choice.map2 f x y - static member ParLift2 (f, (x: Map<'Key,'T> , y : Map<'Key,'U> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) - static member ParLift2 (f, (x: Dictionary<'Key,'T>, y: Dictionary<'Key,'U>), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) - #if !FABLE_COMPILER - static member ParLift2 (f, (x: Expr<'T> , y: Expr<'U> ), _mthd: ParLift2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) - #endif - static member ParLift2 (f, (x: ResizeArray<'T> , y: ResizeArray<'U> ), _mthd: ParLift2) = ResizeArray.map2Shortest f x y - - static member inline Invoke (f: 'T -> 'U -> 'V) (x: '``ParApplicative<'T>``) (y: '``ParApplicative<'U>``) : '``ParApplicative<'V>`` = - let inline call (mthd : ^M, input1: ^I1, input2: ^I2, _output: ^R) = - ((^M or ^I1 or ^I2 or ^R) : (static member ParLift2 : _*(_*_)*_ -> _) f, (input1, input2), mthd) - call (Unchecked.defaultof, x, y, Unchecked.defaultof<'``ParApplicative<'V>``>) - - static member inline InvokeOnInstance (f: 'T -> 'U -> 'V) (x: '``ParApplicative<'T>``) (y: '``ParApplicative<'U>``) = - ((^``ParApplicative<'T>`` or ^``ParApplicative<'U>``) : (static member ParLift2 : _*_*_ -> _) f, x, y) - -type ParLift2 with - static member inline ParLift2 (f, (x, y), _mthd: Default2) = (((ParReturn.InvokeOnInstance f, x) ||> ParApply.InvokeOnInstance), y) ||> ParApply.InvokeOnInstance - - static member inline ParLift2 (_, (_:'t when 't: null and 't: struct, _: ^u when ^u : null and ^u: struct), _mthd: Default1) = id - static member inline ParLift2 (f: 'T -> 'U -> 'V, (x: '``ParApplicative<'T>``, y: '``ParApplicative<'U>``), _mthd: Default1) = ((^``ParApplicative<'T>`` or ^``ParApplicative<'U>`` ) : (static member ParLift2 : _*_*_ -> _) f, x, y) - -type ParLift3 = - inherit Default1 - - static member ParLift3 (f, (x: Lazy<_> , y: Lazy<_> , z: Lazy<_> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) - static member ParLift3 (f, (x: seq<_> , y: seq<_> , z: seq<_> ), _mthd: ParLift3) = Seq.map3 f x y z - static member ParLift3 (f, (x: NonEmptySeq<_> , y: NonEmptySeq<_> , z: NonEmptySeq<_> ), _mthd: ParLift3) = NonEmptySeq.map3 f x y z - static member ParLift3 (f, (x: IEnumerator<_> , y: IEnumerator<_> , z: IEnumerator<_> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) - static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = List.map3Shortest f x y z - static member ParLift3 (f, (x: _ [] , y: _ [] , z: _ [] ), _mthd: ParLift3) = Array.map3Shortest f x y z - static member ParLift3 (f, (x: 'R -> 'T , y: 'R -> 'U , z: 'R -> 'V ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) - static member inline ParLift3 (f, (x: 'Monoid * 'T , y: 'Monoid * 'U , z: 'Monoid * 'V ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) - static member inline ParLift3 (f, (x: struct ('Monoid*'T), y: struct ('Monoid*'U), z: struct ('Monoid* 'T)), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) - #if !FABLE_COMPILER - static member ParLift3 (f, (x: Task<'T> , y: Task<'U> , z: Task<'V> ), _mthd: ParLift3) = Task.pmap3 f x y z - #endif - #if NETSTANDARD2_1 && !FABLE_COMPILER - static member ParLift3 (f, (x: ValueTask<'T> , y: ValueTask<'U> , z: ValueTask<'V> ), _mthd: ParLift3) = ValueTask.pmap3 f x y z - #endif - static member ParLift3 (f, (x , y , z ), _mthd: ParLift3) = Async.pmap3 f x y z - static member ParLift3 (f, (x: option<_> , y: option<_> , z: option<_> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) - - #if !FABLE_COMPILER - static member ParLift3 (f, (x: voption<_> , y: voption<_> , z: voption<_> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) - #endif - static member inline ParLift3 (f, (x: Result<'T,'Error> , y: Result<'U,'Error> , z: Result<'V, 'Error> ), _mthd: ParLift3) = Result.apply3With Plus.Invoke f x y z - static member inline ParLift3 (f, (x: Choice<'T,'Error> , y: Choice<'U,'Error> , z: Choice<'V, 'Error> ), _mthd: ParLift3) = Choice.apply3With Plus.Invoke f x y z - static member ParLift3 (f, (x: Map<'Key,'T> , y: Map<'Key,'U> , z: Map<'Key, 'V> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) - static member ParLift3 (f, (x: Dictionary<'Key,'T>, y: Dictionary<'Key,'U>, z: Dictionary<'Key, 'V>), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) - #if !FABLE_COMPILER - static member ParLift3 (f, (x: Expr<'T> , y: Expr<'U> , z: Expr<'V> ), _mthd: ParLift3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) - #endif - static member ParLift3 (f, (x: ResizeArray<'T> , y: ResizeArray<'U> , z: ResizeArray<'V> ), _mthd: ParLift3) = ResizeArray.map3Shortest f x y z - - static member inline Invoke (f: 'T -> 'U -> 'V -> 'W) (x: '``ParApplicative<'T>``) (y: '``ParApplicative<'U>``) (z: '``ParApplicative<'V>``) : '``ParApplicative<'W>`` = - let inline call (mthd: ^M, input1: ^I1, input2: ^I2, input3: ^I3, _output: ^R) = - ((^M or ^I1 or ^I2 or ^I3 or ^R) : (static member ParLift3 : _*(_*_*_)*_ -> _) f, (input1, input2, input3), mthd) - call (Unchecked.defaultof, x, y, z, Unchecked.defaultof<'``ParApplicative<'W>``>) - - static member inline InvokeOnInstance (f: 'T -> 'U -> 'V -> 'W) (x: '``ParApplicative<'T>``) (y: '``ParApplicative<'U>``) (z: '``ParApplicative<'V>``)= - ((^``ParApplicative<'T>`` or ^``ParApplicative<'U>`` or ^``ParApplicative<'V>``) : (static member ParLift3 : _*_*_*_ -> _) f, x, y, z) - -type ParLift3 with - static member inline ParLift3 (f, (x, y, z), _mthd: Default3) = ((((ParReturn.InvokeOnInstance f, x) ||> ParApply.InvokeOnInstance), y) ||> ParApply.InvokeOnInstance, z) ||> ParApply.InvokeOnInstance - static member inline ParLift3 (_, (_:'t when 't: null and 't: struct, _: ^u when ^u : null and ^u: struct, _: ^v when ^v : null and ^v: struct), _mthd: Default1) = id - static member inline ParLift3 (f: 'T -> 'U -> 'V -> 'W, (x: '``ParApplicative<'T>``, y: '``ParApplicative<'U>``, z: '``ParApplicative<'V>``) , _mthd: Default1) = ((^``ParApplicative<'T>`` or ^``ParApplicative<'U>`` or ^``ParApplicative<'V>`` ) : (static member ParLift3 : _*_*_*_ -> _) f, x, y, z) - -type IsParLeftZero = - inherit Default1 - - static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = Seq.isEmpty t.Value - static member IsParLeftZero (_: ref>, _mthd: IsParLeftZero) = false - static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = List.isEmpty t.Value - static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = Array.isEmpty t.Value - static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = IsLeftZero.IsLeftZero (t, Unchecked.defaultof) - #if !FABLE_COMPILER - static member IsParLeftZero (t: ref> , _mthd: IsParLeftZero) = IsLeftZero.IsLeftZero (t, Unchecked.defaultof) - #endif - static member IsParLeftZero (_: ref> , _mthd: IsParLeftZero) = false - static member IsParLeftZero (_: ref> , _mthd: IsParLeftZero) = false - - static member inline Invoke (x: '``ParApplicative<'T>``) : bool = - let inline call (mthd: ^M, input: ^I) = - ((^M or ^I) : (static member IsParLeftZero : _*_ -> _) ref input, mthd) - call(Unchecked.defaultof, x) - - static member inline InvokeOnInstance (x: '``ParApplicative<'T>``) : bool = - ((^``ParApplicative<'T>``) : (static member IsParLeftZero : _ -> _) x) - -type IsParLeftZero with - - static member inline IsParLeftZero (_: ref<'T> when 'T : struct , _mthd: Default4) = false - static member inline IsParLeftZero (_: ref<'T> when 'T : not struct, _mthd: Default3) = false - - // empty f = empty ==> empty is left zero for - static member inline IsParLeftZero (t: ref<'``Alternative<'T>``> , _mthd: Default2) = (t.Value = Empty.InvokeOnInstance ()) - - static member inline IsParLeftZero (t: ref<'``ParApplicative<'T>``> , _mthd: Default1) = (^``ParApplicative<'T>`` : (static member IsParLeftZero : _ -> _) t.Value) - static member inline IsParLeftZero (_: ref< ^t> when ^t: null and ^t: struct, _: Default1) = () - -#endif diff --git a/src/FSharpPlus/Control/Traversable.fs b/src/FSharpPlus/Control/Traversable.fs index b09393aad..957126000 100644 --- a/src/FSharpPlus/Control/Traversable.fs +++ b/src/FSharpPlus/Control/Traversable.fs @@ -246,12 +246,12 @@ type Sequence with -// Parallel traversables +// Pointwise/Parallel traversables -type ParSequence = +type Transpose = inherit Default1 - static member inline InvokeOnInstance (t: '``ParTraversable<'Functor<'T>>``) = (^``ParTraversable<'Functor<'T>>`` : (static member ParSequence : _ -> _) t) : '``Functor<'ParTraversable<'T>>`` + static member inline InvokeOnInstance (t: '``Traversable<'Functor<'T>>``) = (^``Traversable<'Functor<'T>>`` : (static member Transpose : _ -> _) t) : '``Functor<'Traversable<'T>>`` [] static member inline ForInfiniteSequences (t: seq<_>, []isFailure, []conversion, []result) = @@ -263,69 +263,69 @@ type ParSequence = while go && e.MoveNext () do if isFailure e.Current then go <- false if isEmpty then r <- Map.Invoke List.singleton e.Current - else r <- Map.Invoke add r 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 ParTraverse = +type Gather = inherit Default1 - static member inline InvokeOnInstance f (t: ^a) = (^a : (static member ParTraverse : _ * _ -> 'R) t, f) + static member inline InvokeOnInstance f (t: ^a) = (^a : (static member Gather : _ * _ -> 'R) t, f) - static member inline ParTraverse (t: '``ParTraversable<'T>``, f: 'T -> '``Functor<'U>``, []_output: '``Functor<'ParTraversable<'U>>``, []_impl: Default4) = + static member inline Gather (t: '``Traversable<'T>``, f: 'T -> '``Functor<'U>``, []_output: '``Functor<'Traversable<'U>>``, []_impl: Default4) = #if TEST_TRACE - Traces.add "ParTraverse 'ParTraversable, 'T -> Functor<'U>" + Traces.add "Gather 'Traversable, 'T -> Functor<'U>" #endif - let mapped = Map.Invoke f t : '``ParTraversable<'Functor<'U>>`` - (^``ParTraversable<'T>`` : (static member ParSequence : _ -> _) mapped) : '``Functor<'ParTraversable<'U>>`` + let mapped = Map.Invoke f t : '``Traversable<'Functor<'U>>`` + (^``Traversable<'T>`` : (static member Transpose : _ -> _) mapped) : '``Functor<'Traversable<'U>>`` - static member inline ParTraverse (t: Id<_>, f, []_output: 'R, []_impl: Default3) = + static member inline Gather (t: Id<_>, f, []_output: 'R, []_impl: Default3) = #if TEST_TRACE - Traces.add "ParTraverse Id" + Traces.add "Gather Id" #endif Map.Invoke Id.create (f (Id.run t)) - static member inline ParTraverse (t: _ seq, f, []_output: 'R, []_impl: Default3) = + static member inline Gather (t: _ seq, f, []_output: 'R, []_impl: Default3) = #if TEST_TRACE - Traces.add "ParTraverse seq" + Traces.add "Gather seq" #endif let cons x y = seq {yield x; yield! y} - let cons_f x ys = Map.Invoke (cons: 'a -> seq<_> -> seq<_>) (f x) ys - Seq.foldBack cons_f t (ParReturn.Invoke Seq.empty) + let cons_f x ys = Map.Invoke (cons: 'a -> seq<_> -> seq<_>) (f x) <.> ys + Seq.foldBack cons_f t (Pure.Invoke Seq.empty) - static member inline ParTraverse (t: _ NonEmptySeq, f, []_output: 'R, []_impl: Default3) = + static member inline Gather (t: _ NonEmptySeq, f, []_output: 'R, []_impl: Default3) = #if TEST_TRACE - Traces.add "ParTraverse NonEmptySeq" + Traces.add "Gather NonEmptySeq" #endif let cons x y = seq {yield x; yield! y} - let cons_f x ys = Map.Invoke (cons: 'a -> seq<_> -> seq<_>) (f x) ys - Map.Invoke NonEmptySeq.ofSeq (Seq.foldBack cons_f t (ParReturn.Invoke Seq.empty)) + let cons_f x ys = Map.Invoke (cons: 'a -> seq<_> -> seq<_>) (f x) <.> ys + Map.Invoke NonEmptySeq.ofSeq (Seq.foldBack cons_f t (Pure.Invoke Seq.empty)) - static member inline ParTraverse (t: seq<'T>, f: 'T -> '``Functor<'U>``, []_output: '``Functor>``, []_impl: Default2) = + static member inline Gather (t: seq<'T>, f: 'T -> '``Functor<'U>``, []_output: '``Functor>``, []_impl: Default2) = #if TEST_TRACE - Traces.add "ParTraverse seq, 'T -> Functor<'U>" + Traces.add "Gather seq, 'T -> Functor<'U>" #endif let mapped = Seq.map f t - ParSequence.ForInfiniteSequences (mapped, IsParLeftZero.Invoke, List.toSeq, ParReturn.Invoke) : '``Functor>`` + Transpose.ForInfiniteSequences (mapped, IsZipLeftZero.Invoke, List.toSeq, Pure.Invoke) : '``Functor>`` - static member inline ParTraverse (t: NonEmptySeq<'T>, f: 'T -> '``Functor<'U>``, []_output: '``Functor>``, []_impl: Default2) = + static member inline Gather (t: NonEmptySeq<'T>, f: 'T -> '``Functor<'U>``, []_output: '``Functor>``, []_impl: Default2) = #if TEST_TRACE - Traces.add "ParTraverse NonEmptySeq, 'T -> Functor<'U>" + Traces.add "Gather NonEmptySeq, 'T -> Functor<'U>" #endif let mapped = NonEmptySeq.map f t - ParSequence.ForInfiniteSequences (mapped, IsParLeftZero.Invoke, NonEmptySeq.ofList, ParReturn.Invoke) : '``Functor>`` + Transpose.ForInfiniteSequences (mapped, IsZipLeftZero.Invoke, NonEmptySeq.ofList, Pure.Invoke) : '``Functor>`` - static member inline ParTraverse (t: ^a, f, []_output: 'R, []_impl: Default1) : 'R = + static member inline Gather (t: ^a, f, []_output: 'R, []_impl: Default1) : 'R = #if TEST_TRACE - Traces.add "ParTraverse ^a" + Traces.add "Gather ^a" #endif - ParTraverse.InvokeOnInstance f t - static member inline ParTraverse (_: ^a when ^a : null and ^a :struct, _, _: 'R, _impl: Default1) = id + Gather.InvokeOnInstance f t + static member inline Gather (_: ^a when ^a : null and ^a :struct, _, _: 'R, _impl: Default1) = id #if !FABLE_COMPILER - static member ParTraverse (t: 't seq, f: 't -> Async<'u>, []_output: Async>, []_impl: ParTraverse) : Async> = async { + static member Gather (t: 't seq, f: 't -> Async<'u>, []_output: Async>, []_impl: Gather) : Async> = async { #if TEST_TRACE - Traces.add "ParTraverse 't seq, 't -> Async<'u>" + Traces.add "Gather 't seq, 't -> Async<'u>" #endif let! ct = Async.CancellationToken @@ -336,9 +336,9 @@ type ParTraverse = #endif #if !FABLE_COMPILER - static member ParTraverse (t: 't NonEmptySeq, f: 't -> Async<'u>, []_output: Async>, []_impl: ParTraverse) : Async> = async { + static member Gather (t: 't NonEmptySeq, f: 't -> Async<'u>, []_output: Async>, []_impl: Gather) : Async> = async { #if TEST_TRACE - Traces.add "ParTraverse 't NonEmptySeq, 't -> Async<'u>" + Traces.add "Gather 't NonEmptySeq, 't -> Async<'u>" #endif let! ct = Async.CancellationToken @@ -348,62 +348,62 @@ type ParTraverse = yield Async.RunSynchronously (f enum.Current, cancellationToken = ct) } |> NonEmptySeq.unsafeOfSeq } #endif - static member ParTraverse (t: Id<'t>, f: 't -> option<'u>, []_output: option>, []_impl: ParTraverse) = + static member Gather (t: Id<'t>, f: 't -> option<'u>, []_output: option>, []_impl: Gather) = #if TEST_TRACE - Traces.add "ParTraverse Id, 't -> option<'u>" + Traces.add "Gather Id, 't -> option<'u>" #endif Option.map Id.create (f (Id.run t)) - static member inline ParTraverse (t: option<_>, f, []_output: 'R, []_impl: ParTraverse) : 'R = + static member inline Gather (t: option<_>, f, []_output: 'R, []_impl: Gather) : 'R = #if TEST_TRACE - Traces.add "ParTraverse option" + Traces.add "Gather option" #endif - match t with Some x -> Map.Invoke Some (f x) | _ -> ParReturn.Invoke None + match t with Some x -> Map.Invoke Some (f x) | _ -> Pure.Invoke None - static member inline ParTraverse (t: voption<_>, f, []_output: 'R, []_impl: ParTraverse) : 'R = + static member inline Gather (t: voption<_>, f, []_output: 'R, []_impl: Gather) : 'R = #if TEST_TRACE - Traces.add "ParTraverse voption" + Traces.add "Gather voption" #endif - match t with ValueSome x -> Map.Invoke ValueSome (f x) | _ -> ParReturn.Invoke ValueNone + match t with ValueSome x -> Map.Invoke ValueSome (f x) | _ -> Pure.Invoke ValueNone - static member inline ParTraverse (t:Map<_,_> , f, []_output: 'R, []_impl: ParTraverse) : 'R = + static member inline Gather (t:Map<_,_> , f, []_output: 'R, []_impl: Gather) : 'R = #if TEST_TRACE - Traces.add "ParTraverse Map" + Traces.add "Gather Map" #endif - let insert_f m k v = Map.Invoke (Map.add k) v m - Map.fold insert_f (ParReturn.Invoke Map.empty) (Map.mapValues f t) + let insert_f m k v = Map.Invoke (Map.add k) v <.> m + Map.fold insert_f (Pure.Invoke Map.empty) (Map.mapValues f t) - static member inline ParTraverse (t: Result<'T,'Error>, f: 'T -> '``Functor<'U>``, []_output: '``Functor>``, []_impl: ParTraverse) : '``Functor>`` = + static member inline Gather (t: Result<'T,'Error>, f: 'T -> '``Functor<'U>``, []_output: '``Functor>``, []_impl: Gather) : '``Functor>`` = #if TEST_TRACE - Traces.add "ParTraverse Result, 'T -> Functor<'U>" + Traces.add "Gather Result, 'T -> Functor<'U>" #endif match t with | Ok a -> Map.Invoke Result<'U, 'Error>.Ok (f a) - | Error e -> ParReturn.Invoke (Result<'U, 'Error>.Error e) + | Error e -> Pure.Invoke (Result<'U, 'Error>.Error e) - static member inline ParTraverse (t: Choice<'T,'Error>, f: 'T -> '``Functor<'U>``, []_output: '``Functor>``, []_impl: ParTraverse) : '``Functor>`` = + static member inline Gather (t: Choice<'T,'Error>, f: 'T -> '``Functor<'U>``, []_output: '``Functor>``, []_impl: Gather) : '``Functor>`` = #if TEST_TRACE - Traces.add "ParTraverse Choice, 'T -> Functor<'U>" + Traces.add "Gather Choice, 'T -> Functor<'U>" #endif match t with | Choice1Of2 a -> Map.Invoke Choice<'U,'Error>.Choice1Of2 (f a) - | Choice2Of2 e -> ParReturn.Invoke (Choice<'U,'Error>.Choice2Of2 e) + | Choice2Of2 e -> Pure.Invoke (Choice<'U,'Error>.Choice2Of2 e) - static member inline ParTraverse (t:list<_>,f , []_output: 'R, []_impl: ParTraverse) : 'R = + static member inline Gather (t:list<_>,f , []_output: 'R, []_impl: Gather) : 'R = #if TEST_TRACE - Traces.add "ParTraverse list" + Traces.add "Gather list" #endif let rec loop acc = function | [] -> acc | x::xs -> let v = f x loop (v::acc) xs - let cons_f x xs = Map.Invoke List.cons xs x - List.fold cons_f (ParReturn.Invoke []) (loop [] t) + let cons_f x xs = Map.Invoke List.cons xs <.> x + List.fold cons_f (Pure.Invoke []) (loop [] t) - static member inline ParTraverse (t:_ [],f , []_output: 'R, []_impl: ParTraverse) : 'R = + static member inline Gather (t:_ [],f , []_output: 'R, []_impl: Gather) : 'R = #if TEST_TRACE - Traces.add "ParTraverse []" + Traces.add "Gather []" #endif let cons x y = Array.append [|x|] y let rec loop acc = function @@ -412,78 +412,78 @@ type ParTraverse = let x, xs = Array.head xxs, Array.tail xxs let v = f x loop (cons v acc) xs - let cons_f x xs = Map.Invoke cons xs x - Array.fold cons_f (ParReturn.Invoke [||]) (loop [||] t) + let cons_f x xs = Map.Invoke cons xs <.> x + Array.fold cons_f (Pure.Invoke [||]) (loop [||] t) - static member inline Invoke (f: 'T -> '``Functor<'U>``) (t: '``ParTraversable<'T>``) : '``Functor<'ParTraversable<'U>>`` = - let inline call_3 (a: ^a, b: ^b, c: ^c, f) = ((^a or ^b or ^c) : (static member ParTraverse : _*_*_*_ -> _) b, f, c, a) + static member inline Invoke (f: 'T -> '``Functor<'U>``) (t: '``Traversable<'T>``) : '``Functor<'Traversable<'U>>`` = + let inline call_3 (a: ^a, b: ^b, c: ^c, f) = ((^a or ^b or ^c) : (static member Gather : _*_*_*_ -> _) b, f, c, a) let inline call (a: 'a, b: 'b, f) = call_3 (a, b, Unchecked.defaultof<'R>, f) : 'R - call (Unchecked.defaultof, t, f) + call (Unchecked.defaultof, t, f) -type ParSequence with +type Transpose with - static member inline ParSequence (t: _ seq, []_output: 'R, []_impl: Default5) : 'R = + static member inline Transpose (t: _ seq, []_output: 'R, []_impl: Default5) : 'R = let cons x y = seq { yield x; yield! y } - let cons_f x ys = Map.Invoke (cons: 'a -> seq<_> -> seq<_>) x ys - Seq.foldBack cons_f t (ParReturn.Invoke Seq.empty) + let cons_f x ys = Map.Invoke (cons: 'a -> seq<_> -> seq<_>) x <.> ys + Seq.foldBack cons_f t (Pure.Invoke Seq.empty) - static member inline ParSequence (t: seq<'``Applicative<'T>``>, []_output: '``Applicative>`` , []_impl: Default4) : '``Applicative>`` = - ParSequence.ForInfiniteSequences (t, IsParLeftZero.Invoke, List.toSeq, ParReturn.Invoke) + static member inline Transpose (t: seq<'``Applicative<'T>``>, []_output: '``Applicative>`` , []_impl: Default4) : '``Applicative>`` = + Transpose.ForInfiniteSequences (t, IsZipLeftZero.Invoke, List.toSeq, Pure.Invoke) - static member ParSequence (t: seq> , []_output: option> , []_impl: Default3) : option> = Option.Sequence t + static member Transpose (t: seq> , []_output: option> , []_impl: Default3) : option> = Option.Sequence t #if !FABLE_COMPILER - static member ParSequence (t: seq> , []_output: voption> , []_impl: Default3) : voption> = ValueOption.Sequence t + static member Transpose (t: seq> , []_output: voption> , []_impl: Default3) : voption> = ValueOption.Sequence t #endif - static member inline ParSequence (t: seq>, []_output: Result, 'e>, []_impl: Default3) : Result, 'e> = Result.Parallel ((++), t) - static member inline ParSequence (t: seq>, []_output: Choice, 'e>, []_impl: Default3) : Choice, 'e> = Choice.Parallel ((++), t) - static member ParSequence (t: seq> , []_output: list> , []_impl: Default3) : list> = ParSequence.ForInfiniteSequences (t, List.isEmpty, List.toSeq, List.singleton >> List.cycle) + static member inline Transpose (t: seq>, []_output: Result, 'e>, []_impl: Default3) : Result, 'e> = Result.Parallel ((++), t) + static member inline Transpose (t: seq>, []_output: Choice, 'e>, []_impl: Default3) : Choice, 'e> = Choice.Parallel ((++), t) + static member Transpose (t: seq> , []_output: list> , []_impl: Default3) : list> = Transpose.ForInfiniteSequences (t, List.isEmpty, List.toSeq, List.singleton >> List.cycle) #if !FABLE_COMPILER - static member ParSequence (t: seq> , []_output: Async> , []_impl: Default3) : Async> = Async.Parallel t |> Async.map Array.toSeq + static member Transpose (t: seq> , []_output: Async> , []_impl: Default3) : Async> = Async.Parallel t |> Async.map Array.toSeq #endif - static member inline ParSequence (t: NonEmptySeq<'``Applicative<'T>``>, []_output: '``Applicative>``, []_impl: Default4) : '``Applicative>`` = ParSequence.ForInfiniteSequences (t, IsParLeftZero.Invoke, NonEmptySeq.ofList, fun _ -> Unchecked.defaultof<_>) - static member ParSequence (t: NonEmptySeq> , []_output: option> , []_impl: Default3) : option> = Option.Sequence t |> Option.map NonEmptySeq.unsafeOfSeq - static member inline ParSequence (t: NonEmptySeq>, []_output: Result, 'e>, []_impl: Default3) : Result, 'e> = Result.Parallel ((++), t) |> Result.map NonEmptySeq.unsafeOfSeq - static member inline ParSequence (t: NonEmptySeq>, []_output: Choice, 'e>, []_impl: Default3) : Choice, 'e> = Choice.Parallel ((++), t) |> Choice.map NonEmptySeq.unsafeOfSeq - static member ParSequence (t: NonEmptySeq> , []_output: list> , []_impl: Default3) : list> = ParSequence.ForInfiniteSequences (t, List.isEmpty , NonEmptySeq.ofList, fun _ -> Unchecked.defaultof<_>) - static member ParSequence (t: NonEmptySeq<'t []> , []_output: NonEmptySeq<'t> [] , []_impl: Default3) : NonEmptySeq<'t> [] = ParSequence.ForInfiniteSequences (t, Array.isEmpty, NonEmptySeq.ofList, fun _ -> Unchecked.defaultof<_>) + static member inline Transpose (t: NonEmptySeq<'``Applicative<'T>``>, []_output: '``Applicative>``, []_impl: Default4) : '``Applicative>`` = Transpose.ForInfiniteSequences (t, IsZipLeftZero.Invoke, NonEmptySeq.ofList, fun _ -> Unchecked.defaultof<_>) + static member Transpose (t: NonEmptySeq> , []_output: option> , []_impl: Default3) : option> = Option.Sequence t |> Option.map NonEmptySeq.unsafeOfSeq + static member inline Transpose (t: NonEmptySeq>, []_output: Result, 'e>, []_impl: Default3) : Result, 'e> = Result.Parallel ((++), t) |> Result.map NonEmptySeq.unsafeOfSeq + static member inline Transpose (t: NonEmptySeq>, []_output: Choice, 'e>, []_impl: Default3) : Choice, 'e> = Choice.Parallel ((++), t) |> Choice.map NonEmptySeq.unsafeOfSeq + static member Transpose (t: NonEmptySeq> , []_output: list> , []_impl: Default3) : list> = Transpose.ForInfiniteSequences (t, List.isEmpty , NonEmptySeq.ofList, fun _ -> Unchecked.defaultof<_>) + static member Transpose (t: NonEmptySeq<'t []> , []_output: NonEmptySeq<'t> [] , []_impl: Default3) : NonEmptySeq<'t> [] = Transpose.ForInfiniteSequences (t, Array.isEmpty, NonEmptySeq.ofList, fun _ -> Unchecked.defaultof<_>) #if !FABLE_COMPILER - static member ParSequence (t: NonEmptySeq> , []_output: Async> , []_impl: Default3) = Async.Parallel t |> Async.map NonEmptySeq.unsafeOfSeq : Async> + static member Transpose (t: NonEmptySeq> , []_output: Async> , []_impl: Default3) = Async.Parallel t |> Async.map NonEmptySeq.unsafeOfSeq : Async> #endif - static member inline ParSequence (t: ^a , []_output: 'R, []_impl: Default2) : 'R = ParTraverse.InvokeOnInstance id t - static member inline ParSequence (t: ^a , []_output: 'R, []_impl: Default1) : 'R = ParSequence.InvokeOnInstance t + static member inline Transpose (t: ^a , []_output: 'R, []_impl: Default2) : 'R = Gather.InvokeOnInstance id t + static member inline Transpose (t: ^a , []_output: 'R, []_impl: Default1) : 'R = Transpose.InvokeOnInstance t - static member inline ParSequence (t: option<_> , []_output: 'R, []_impl: ParSequence) : 'R = match t with Some x -> Map.Invoke Some x | _ -> ParReturn.Invoke None + static member inline Transpose (t: option<_> , []_output: 'R, []_impl: Transpose) : 'R = match t with Some x -> Map.Invoke Some x | _ -> Pure.Invoke None #if !FABLE_COMPILER - static member inline ParSequence (t: voption<_>, []_output: 'R, []_impl: ParSequence) : 'R = match t with ValueSome x -> Map.Invoke ValueSome x | _ -> ParReturn.Invoke ValueNone + static member inline Transpose (t: voption<_>, []_output: 'R, []_impl: Transpose) : 'R = match t with ValueSome x -> Map.Invoke ValueSome x | _ -> Pure.Invoke ValueNone #endif - static member inline ParSequence (t: list<_> , []_output: 'R, []_impl: ParSequence) : 'R = ParSequence.ForInfiniteSequences (t, IsParLeftZero.Invoke, id, ParReturn.Invoke) + static member inline Transpose (t: list<_> , []_output: 'R, []_impl: Transpose) : 'R = Transpose.ForInfiniteSequences (t, IsZipLeftZero.Invoke, id, Pure.Invoke) - static member inline ParSequence (t: Map<_,_> , []_output: 'R, []_impl: ParSequence) : 'R = - let insert_f k x ys = Map.Invoke (Map.add k) x ys - Map.foldBack insert_f t (ParReturn.Invoke Map.empty) + static member inline Transpose (t: Map<_,_> , []_output: 'R, []_impl: Transpose) : 'R = + let insert_f k x ys = Map.Invoke (Map.add k) x <.> ys + Map.foldBack insert_f t (Pure.Invoke Map.empty) - static member inline ParSequence (t: Result<'``Functor<'T>``,'Error>, []_output: '``Functor>``, []_impl: ParSequence) : '``Functor>`` = + static member inline Transpose (t: Result<'``Functor<'T>``,'Error>, []_output: '``Functor>``, []_impl: Transpose) : '``Functor>`` = match t with | Ok a -> Map.Invoke Result<'T,'Error>.Ok a - | Error e -> ParReturn.Invoke (Result<'T,'Error>.Error e) + | Error e -> Pure.Invoke (Result<'T,'Error>.Error e) - static member inline ParSequence (t: Choice<'``Functor<'T>``,'Error>, []_output: '``Functor>``, []_impl: ParSequence) : '``Functor>`` = + static member inline Transpose (t: Choice<'``Functor<'T>``,'Error>, []_output: '``Functor>``, []_impl: Transpose) : '``Functor>`` = match t with | Choice1Of2 a -> Map.Invoke Choice<'T,'Error>.Choice1Of2 a - | Choice2Of2 e -> ParReturn.Invoke (Choice<'T,'Error>.Choice2Of2 e) + | Choice2Of2 e -> Pure.Invoke (Choice<'T,'Error>.Choice2Of2 e) - static member inline ParSequence (t: _ [] , []_output: 'R , []_impl: ParSequence) : 'R = ParSequence.ForInfiniteSequences (t, IsParLeftZero.Invoke, Array.ofList, ParReturn.Invoke) + static member inline Transpose (t: _ [] , []_output: 'R , []_impl: Transpose) : 'R = Transpose.ForInfiniteSequences (t, IsZipLeftZero.Invoke, Array.ofList, Pure.Invoke) - static member inline ParSequence (t: Id<'``Functor<'T>``> , []_output: '``Functor>`` , []_impl: ParSequence) : '``Functor>`` = ParTraverse.Invoke id t + static member inline Transpose (t: Id<'``Functor<'T>``> , []_output: '``Functor>`` , []_impl: Transpose) : '``Functor>`` = Gather.Invoke id t - static member inline ParSequence (t: ResizeArray<'``Functor<'T>``>, []_output: '``Functor>``, []_impl: ParSequence) : '``Functor>``= ParTraverse.Invoke id t + static member inline Transpose (t: ResizeArray<'``Functor<'T>``>, []_output: '``Functor>``, []_impl: Transpose) : '``Functor>``= Gather.Invoke id t - static member inline Invoke (t: '``ParTraversable<'Applicative<'T>>``) : '``Applicative<'ParTraversable<'T>>`` = - let inline call_3 (a: ^a, b: ^b, c: ^c) = ((^a or ^b or ^c) : (static member ParSequence : _*_*_ -> _) b, c, a) + static member inline Invoke (t: '``Traversable<'Applicative<'T>>``) : '``Applicative<'Traversable<'T>>`` = + let inline call_3 (a: ^a, b: ^b, c: ^c) = ((^a or ^b or ^c) : (static member Transpose : _*_*_ -> _) b, c, a) let inline call (a: 'a, b: 'b) = call_3 (a, b, Unchecked.defaultof<'R>) : 'R - call (Unchecked.defaultof, t) + call (Unchecked.defaultof, t) #endif \ No newline at end of file diff --git a/src/FSharpPlus/Control/ZipApplicative.fs b/src/FSharpPlus/Control/ZipApplicative.fs new file mode 100644 index 000000000..3668ed8f6 --- /dev/null +++ b/src/FSharpPlus/Control/ZipApplicative.fs @@ -0,0 +1,254 @@ +namespace FSharpPlus.Control + +open System +open System.Text +open System.Runtime.InteropServices +open System.Collections.Generic +open System.Threading.Tasks +open Microsoft.FSharp.Quotations + +open FSharpPlus.Internals +open FSharpPlus.Internals.Prelude +open FSharpPlus +open FSharpPlus.Data + + +type Pure = + inherit Default1 + static member inline InvokeOnInstance (x: 'T) = (^``ZipApplicative<'T>`` : (static member Pure : ^T -> ^``ZipApplicative<'T>``) x) + +#if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 + + static member inline Invoke (x: 'T) : '``ZipApplicative<'T>`` = + let inline call (mthd: ^M, output: ^R) = ((^M or ^R) : (static member Pure : _*_ -> _) output, mthd) + call (Unchecked.defaultof, Unchecked.defaultof<'``ZipApplicative<'T>``>) x + + static member Pure (_: seq<'a> , _: Default2 ) = fun x -> Seq.initInfinite (fun _ -> x) : seq<'a> + static member Pure (_: NonEmptySeq<'a> , _: Default2 ) = fun x -> NonEmptySeq.initInfinite (fun _ -> x) : NonEmptySeq<'a> + static member Pure (_: IEnumerator<'a> , _: Default2 ) = fun x -> Enumerator.upto None (fun _ -> x) : IEnumerator<'a> + static member inline Pure (_: 'R , _: Default1 ) = fun (x: 'T) -> Pure.InvokeOnInstance x : 'R + static member Pure (x: Lazy<'a> , _: Pure) = Return.Return (x, Unchecked.defaultof) : _ -> Lazy<'a> + #if !FABLE_COMPILER + static member Pure (_: 'T Task , _: Pure) = fun x -> Task.FromResult x : 'T Task + #endif + #if NETSTANDARD2_1 && !FABLE_COMPILER + static member Pure (_: 'T ValueTask , _: Pure) = fun (x: 'T) -> ValueTask<'T> x : 'T ValueTask + #endif + static member Pure (x: option<'a> , _: Pure) = Return.Return (x, Unchecked.defaultof) + static member Pure (x: voption<'a> , _: Pure) = Return.Return (x, Unchecked.defaultof) + static member Pure (_: list<'a> , _: Pure) = fun x -> List.cycle [x] : list<'a> + + [] + static member Pure (x: 'a [] , _: Pure) = Return.Return (x, Unchecked.defaultof) + + static member Pure (x: 'r -> 'a , _: Pure) = Return.Return (x, Unchecked.defaultof) + static member inline Pure (x: 'm * 'a , _: Pure) = Return.Return (x, Unchecked.defaultof) + static member inline Pure (x: struct ('m * 'a), _: Pure) = Return.Return (x, Unchecked.defaultof) + static member Pure (_: 'a Async , _: Pure) = fun (x: 'a) -> async.Return x + static member inline Pure (_: Result<'t, 'e> , _: Pure) = fun x -> if opaqueId false then Error (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e>) else Ok x : Result<'t, 'e> + static member inline Pure (_: Choice<'t, 'e> , _: Pure) = fun x -> if opaqueId false then Choice2Of2 (Plus.Invoke Unchecked.defaultof<'e> Unchecked.defaultof<'e>) else Choice1Of2 x : Choice<'t, 'e> + #if !FABLE_COMPILER + static member Pure (x: Expr<'a> , _: Pure) = Return.Return (x, Unchecked.defaultof) + #endif + + [", 10720, IsError = true)>] + static member Pure (x: ResizeArray<'a>, _: Pure ) = Return.Return (x, Unchecked.defaultof) + + //Restricted + [] + static member Pure (_: string , _: Pure ) = fun (x: char) -> string x : string + [] + static member Pure (_: StringBuilder , _: Pure ) = fun (x: char) -> new StringBuilder (string x) : StringBuilder + [] + static member Pure (_: 'a Set , _: Pure ) = fun (x: 'a ) -> Set.singleton x + static member Pure (_: 'a Set2 , _: Pure ) = fun (_: 'a ) -> Set2() : 'a Set2 + +#endif + +type ZipApply = + inherit Default1 + +#if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 + + static member ``<.>`` (struct (f: Lazy<'T->'U> , x: Lazy<'T> ), []_output: Lazy<'U> , []_mthd: ZipApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ``<.>`` (struct (f: seq<_> , x: seq<'T> ), []_output: seq<'U> , []_mthd: ZipApply) = Seq.map2 (<|) f x + static member ``<.>`` (struct (f: NonEmptySeq<_> , x: NonEmptySeq<'T> ), []_output: NonEmptySeq<'U> , []_mthd: ZipApply) = NonEmptySeq.map2 (<|) f x + static member ``<.>`` (struct (f: IEnumerator<_> , x: IEnumerator<'T> ), []_output: IEnumerator<'U> , []_mthd: ZipApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ``<.>`` (struct (f: list<_> , x: list<'T> ), []_output: list<'U> , []_mthd: ZipApply) = List.map2Shortest (<|) f x + static member ``<.>`` (struct (f: _ [] , x: 'T [] ), []_output: 'U [] , []_mthd: ZipApply) = Array.map2Shortest (<|) f x + static member ``<.>`` (struct (f: 'r -> _ , x: _ -> 'T ), []_output: 'r -> 'U , []_mthd: ZipApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member inline ``<.>`` (struct (f: 'Monoid * _ , x: ('Monoid * 'T) ), []_output: 'Monoid * 'U , []_mthd: ZipApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member inline ``<.>`` (struct (f: struct ('Monoid * _), x: struct ('Monoid * 'T)), []_output: struct ('Monoid * 'U), []_mthd: ZipApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + #if !FABLE_COMPILER + static member ``<.>`` (struct (f: Task<_> , x: Task<'T> ), []_output: Task<'U> , []_mthd: ZipApply) = Task.map2 (<|) f x + #endif + #if !NET45 && !NETSTANDARD2_0 && !FABLE_COMPILER + static member ``<.>`` (struct (f: ValueTask<_> , x: ValueTask<'T> ), []_output: ValueTask<'U> , []_mthd: ZipApply) = ValueTask.map2 (<|) f x + #endif + static member ``<.>`` (struct (f: Async<_> , x: Async<'T> ), []_output: Async<'U> , []_mthd: ZipApply) : Async<'U> = Async.map2 (<|) f x + static member ``<.>`` (struct (f: option<_> , x: option<'T> ), []_output: option<'U> , []_mthd: ZipApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ``<.>`` (struct (f: voption<_> , x: voption<'T> ), []_output: voption<'U> , []_mthd: ZipApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member inline ``<.>`` (struct (f: Result<_,'E> , x: Result<'T,'E> ), []_output: Result<'b,'E> , []_mthd: ZipApply) : Result<'U, 'E> = Result.apply2With Plus.Invoke (<|) f x + static member inline ``<.>`` (struct (f: Choice<_,'E> , x: Choice<'T,'E> ), []_output: Choice<'b,'E> , []_mthd: ZipApply) : Choice<'U, 'E> = Choice.apply2With Plus.Invoke (<|) f x + static member inline ``<.>`` (struct (f: KeyValuePair<'Key,_>, x: KeyValuePair<'Key,'T>), []_output: KeyValuePair<'Key,'U>, []_mthd: Default2) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member inline ``<.>`` (struct (f: KeyValuePair2<_,_> , x: KeyValuePair2<_,'T> ) , _output: KeyValuePair2<_,'U> , _mthd: Default2) : KeyValuePair2<'Key,'U> = + let a, b = f.Key, x.Key + let f, x = f.Value, x.Value + KeyValuePair2 (Plus.Invoke a b, f x) + + + static member ``<.>`` (struct (f: Map<'Key,_> , x: Map<'Key,'T> ), []_output: Map<'Key,'U> , []_mthd: ZipApply) : Map<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ``<.>`` (struct (f: Dictionary<'Key,_> , x: Dictionary<'Key,'T> ), []_output: Dictionary<'Key,'U> , []_mthd: ZipApply) : Dictionary<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ``<.>`` (struct (f: IDictionary<'Key,_> , x: IDictionary<'Key,'T> ), []_output: IDictionary<'Key,'U> , []_mthd: ZipApply) : IDictionary<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + static member ``<.>`` (struct (f: IReadOnlyDictionary<'Key,_>, x: IReadOnlyDictionary<'Key,'T> ), []_output: IReadOnlyDictionary<'Key,'U>, []_mthd: ZipApply) : IReadOnlyDictionary<'Key,'U> = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + + #if !FABLE_COMPILER + static member ``<.>`` (struct (f: Expr<'T->'U>, x: Expr<'T>), []_output: Expr<'U>, []_mthd: ZipApply) = Apply.``<*>`` (struct (f, x), _output, Unchecked.defaultof) + #endif + static member ``<.>`` (struct (f: ('T->'U) ResizeArray, x: 'T ResizeArray), []_output: 'U ResizeArray, []_mthd: ZipApply) = ResizeArray.map2Shortest (<|) f x + + static member inline Invoke (f: '``ZipApplicative<'T -> 'U>``) (x: '``ZipApplicative<'T>``) : '``ZipApplicative<'U>`` = + let inline call (mthd: ^M, input1: ^I1, input2: ^I2, output: ^R) = + ((^M or ^I1 or ^I2 or ^R) : (static member ``<.>`` : struct (_*_) * _ * _ -> _) (struct (input1, input2)), output, mthd) + call(Unchecked.defaultof, f, x, Unchecked.defaultof<'``ZipApplicative<'U>``>) + +#endif + + static member inline InvokeOnInstance (f: '``ZipApplicative<'T->'U>``) (x: '``ZipApplicative<'T>``) : '``ZipApplicative<'U>`` = + ((^``ZipApplicative<'T->'U>`` or ^``ZipApplicative<'T>`` or ^``ZipApplicative<'U>``) : (static member (<.>) : _*_ -> _) (f, x)) + +#if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 + +type ZipApply with + static member inline ``<.>`` (struct (_: ^t when ^t : null and ^t: struct, _: ^u when ^u : null and ^u: struct), _output: ^r when ^r : null and ^r: struct, _mthd: Default1) = id + static member inline ``<.>`` (struct (f: '``Applicative<'T->'U>``, x: '``Applicative<'T>``), _output: '``Applicative<'U>``, []_mthd: Default1) : '``Applicative<'U>`` = + ((^``Applicative<'T->'U>`` or ^``Applicative<'T>`` or ^``Applicative<'U>``) : (static member (<.>) : _*_ -> _) f, x) + + +type Map2 = + inherit Default1 + + static member Map2 (f, (x: Lazy<_> , y: Lazy<_> ), _mthd: Map2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member Map2 (f, (x: seq<_> , y: seq<_> ), _mthd: Map2) = Seq.map2 f x y + static member Map2 (f, (x: NonEmptySeq<_> , y: NonEmptySeq<_> ), _mthd: Map2) = NonEmptySeq.map2 f x y + static member Map2 (f, (x: IEnumerator<_> , y: IEnumerator<_> ), _mthd: Map2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member Map2 (f, (x , y ), _mthd: Map2) = List.map2Shortest f x y + static member Map2 (f, (x: _ [] , y: _ [] ), _mthd: Map2) = Array.map2Shortest f x y + static member Map2 (f, (x: 'R -> 'T , y: 'R -> 'U ), _mthd: Map2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member inline Map2 (f, (x: 'Monoid * 'T , y: 'Monoid * 'U ), _mthd: Map2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member inline Map2 (f, (x: struct ('Monoid*'T), y: struct ('Monoid*'U)), _mthd: Map2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + #if !FABLE_COMPILER + static member Map2 (f, (x: Task<'T> , y: Task<'U> ), _mthd: Map2) = Task.map2 f x y + #endif + #if NETSTANDARD2_1 && !FABLE_COMPILER + static member Map2 (f, (x: ValueTask<'T> , y: ValueTask<'U> ), _mthd: Map2) = ValueTask.map2 f x y + #endif + static member Map2 (f, (x , y ), _mthd: Map2) = Async.map2 f x y + static member Map2 (f, (x: option<_> , y: option<_> ), _mthd: Map2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + + #if !FABLE_COMPILER + static member Map2 (f, (x: voption<_> , y: voption<_> ), _mthd: Map2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + #endif + static member inline Map2 (f, (x: Result<'T,'Error> , y: Result<'U,'Error> ), _mthd: Map2) = Result.apply2With Plus.Invoke f x y + static member inline Map2 (f, (x: Choice<'T,'Error> , y: Choice<'U,'Error> ), _mthd: Map2) = Choice.map2 f x y + static member Map2 (f, (x: Map<'Key,'T> , y : Map<'Key,'U> ), _mthd: Map2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + static member Map2 (f, (x: Dictionary<'Key,'T>, y: Dictionary<'Key,'U>), _mthd: Map2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + #if !FABLE_COMPILER + static member Map2 (f, (x: Expr<'T> , y: Expr<'U> ), _mthd: Map2) = Lift2.Lift2 (f, (x, y), Unchecked.defaultof) + #endif + static member Map2 (f, (x: ResizeArray<'T> , y: ResizeArray<'U> ), _mthd: Map2) = ResizeArray.map2Shortest f x y + + static member inline Invoke (f: 'T -> 'U -> 'V) (x: '``ZipApplicative<'T>``) (y: '``ZipApplicative<'U>``) : '``ZipApplicative<'V>`` = + let inline call (mthd : ^M, input1: ^I1, input2: ^I2, _output: ^R) = + ((^M or ^I1 or ^I2 or ^R) : (static member Map2 : _*(_*_)*_ -> _) f, (input1, input2), mthd) + call (Unchecked.defaultof, x, y, Unchecked.defaultof<'``ZipApplicative<'V>``>) + + static member inline InvokeOnInstance (f: 'T -> 'U -> 'V) (x: '``ZipApplicative<'T>``) (y: '``ZipApplicative<'U>``) = + ((^``ZipApplicative<'T>`` or ^``ZipApplicative<'U>``) : (static member Map2 : _*_*_ -> _) f, x, y) + +type Map2 with + static member inline Map2 (f, (x, y), _mthd: Default2) = (((Pure.InvokeOnInstance f, x) ||> ZipApply.InvokeOnInstance), y) ||> ZipApply.InvokeOnInstance + + static member inline Map2 (_, (_:'t when 't: null and 't: struct, _: ^u when ^u : null and ^u: struct), _mthd: Default1) = id + static member inline Map2 (f: 'T -> 'U -> 'V, (x: '``ZipApplicative<'T>``, y: '``ZipApplicative<'U>``), _mthd: Default1) = ((^``ZipApplicative<'T>`` or ^``ZipApplicative<'U>`` ) : (static member Map2 : _*_*_ -> _) f, x, y) + +type Map3 = + inherit Default1 + + static member Map3 (f, (x: Lazy<_> , y: Lazy<_> , z: Lazy<_> ), _mthd: Map3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member Map3 (f, (x: seq<_> , y: seq<_> , z: seq<_> ), _mthd: Map3) = Seq.map3 f x y z + static member Map3 (f, (x: NonEmptySeq<_> , y: NonEmptySeq<_> , z: NonEmptySeq<_> ), _mthd: Map3) = NonEmptySeq.map3 f x y z + static member Map3 (f, (x: IEnumerator<_> , y: IEnumerator<_> , z: IEnumerator<_> ), _mthd: Map3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member Map3 (f, (x , y , z ), _mthd: Map3) = List.map3Shortest f x y z + static member Map3 (f, (x: _ [] , y: _ [] , z: _ [] ), _mthd: Map3) = Array.map3Shortest f x y z + static member Map3 (f, (x: 'R -> 'T , y: 'R -> 'U , z: 'R -> 'V ), _mthd: Map3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member inline Map3 (f, (x: 'Monoid * 'T , y: 'Monoid * 'U , z: 'Monoid * 'V ), _mthd: Map3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member inline Map3 (f, (x: struct ('Monoid*'T), y: struct ('Monoid*'U), z: struct ('Monoid* 'T)), _mthd: Map3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + #if !FABLE_COMPILER + static member Map3 (f, (x: Task<'T> , y: Task<'U> , z: Task<'V> ), _mthd: Map3) = Task.map3 f x y z + #endif + #if NETSTANDARD2_1 && !FABLE_COMPILER + static member Map3 (f, (x: ValueTask<'T> , y: ValueTask<'U> , z: ValueTask<'V> ), _mthd: Map3) = ValueTask.map3 f x y z + #endif + static member Map3 (f, (x , y , z ), _mthd: Map3) = Async.map3 f x y z + static member Map3 (f, (x: option<_> , y: option<_> , z: option<_> ), _mthd: Map3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + + #if !FABLE_COMPILER + static member Map3 (f, (x: voption<_> , y: voption<_> , z: voption<_> ), _mthd: Map3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + #endif + static member inline Map3 (f, (x: Result<'T,'Error> , y: Result<'U,'Error> , z: Result<'V, 'Error> ), _mthd: Map3) = Result.apply3With Plus.Invoke f x y z + static member inline Map3 (f, (x: Choice<'T,'Error> , y: Choice<'U,'Error> , z: Choice<'V, 'Error> ), _mthd: Map3) = Choice.apply3With Plus.Invoke f x y z + static member Map3 (f, (x: Map<'Key,'T> , y: Map<'Key,'U> , z: Map<'Key, 'V> ), _mthd: Map3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + static member Map3 (f, (x: Dictionary<'Key,'T>, y: Dictionary<'Key,'U>, z: Dictionary<'Key, 'V>), _mthd: Map3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + #if !FABLE_COMPILER + static member Map3 (f, (x: Expr<'T> , y: Expr<'U> , z: Expr<'V> ), _mthd: Map3) = Lift3.Lift3 (f, (x, y, z), Unchecked.defaultof) + #endif + static member Map3 (f, (x: ResizeArray<'T> , y: ResizeArray<'U> , z: ResizeArray<'V> ), _mthd: Map3) = ResizeArray.map3Shortest f x y z + + static member inline Invoke (f: 'T -> 'U -> 'V -> 'W) (x: '``ZipApplicative<'T>``) (y: '``ZipApplicative<'U>``) (z: '``ZipApplicative<'V>``) : '``ZipApplicative<'W>`` = + let inline call (mthd: ^M, input1: ^I1, input2: ^I2, input3: ^I3, _output: ^R) = + ((^M or ^I1 or ^I2 or ^I3 or ^R) : (static member Map3 : _*(_*_*_)*_ -> _) f, (input1, input2, input3), mthd) + call (Unchecked.defaultof, x, y, z, Unchecked.defaultof<'``ZipApplicative<'W>``>) + + static member inline InvokeOnInstance (f: 'T -> 'U -> 'V -> 'W) (x: '``ZipApplicative<'T>``) (y: '``ZipApplicative<'U>``) (z: '``ZipApplicative<'V>``)= + ((^``ZipApplicative<'T>`` or ^``ZipApplicative<'U>`` or ^``ZipApplicative<'V>``) : (static member Map3 : _*_*_*_ -> _) f, x, y, z) + +type Map3 with + static member inline Map3 (f, (x, y, z), _mthd: Default3) = ((((Pure.InvokeOnInstance f, x) ||> ZipApply.InvokeOnInstance), y) ||> ZipApply.InvokeOnInstance, z) ||> ZipApply.InvokeOnInstance + static member inline Map3 (_, (_:'t when 't: null and 't: struct, _: ^u when ^u : null and ^u: struct, _: ^v when ^v : null and ^v: struct), _mthd: Default1) = id + static member inline Map3 (f: 'T -> 'U -> 'V -> 'W, (x: '``ZipApplicative<'T>``, y: '``ZipApplicative<'U>``, z: '``ZipApplicative<'V>``) , _mthd: Default1) = ((^``ZipApplicative<'T>`` or ^``ZipApplicative<'U>`` or ^``ZipApplicative<'V>`` ) : (static member Map3 : _*_*_*_ -> _) f, x, y, z) + +type IsZipLeftZero = + inherit Default1 + + static member IsZipLeftZero (t: ref> , _mthd: IsZipLeftZero) = Seq.isEmpty t.Value + static member IsZipLeftZero (_: ref>, _mthd: IsZipLeftZero) = false + static member IsZipLeftZero (t: ref> , _mthd: IsZipLeftZero) = List.isEmpty t.Value + static member IsZipLeftZero (t: ref> , _mthd: IsZipLeftZero) = Array.isEmpty t.Value + static member IsZipLeftZero (t: ref> , _mthd: IsZipLeftZero) = IsLeftZero.IsLeftZero (t, Unchecked.defaultof) + #if !FABLE_COMPILER + static member IsZipLeftZero (t: ref> , _mthd: IsZipLeftZero) = IsLeftZero.IsLeftZero (t, Unchecked.defaultof) + #endif + static member IsZipLeftZero (_: ref> , _mthd: IsZipLeftZero) = false + static member IsZipLeftZero (_: ref> , _mthd: IsZipLeftZero) = false + + static member inline Invoke (x: '``ZipApplicative<'T>``) : bool = + let inline call (mthd: ^M, input: ^I) = + ((^M or ^I) : (static member IsZipLeftZero : _*_ -> _) ref input, mthd) + call(Unchecked.defaultof, x) + + static member inline InvokeOnInstance (x: '``ZipApplicative<'T>``) : bool = + ((^``ZipApplicative<'T>``) : (static member IsZipLeftZero : _ -> _) x) + +type IsZipLeftZero with + + static member inline IsZipLeftZero (_: ref<'T> when 'T : struct , _mthd: Default4) = false + static member inline IsZipLeftZero (_: ref<'T> when 'T : not struct, _mthd: Default3) = false + + // empty <.> f = empty ==> empty is left zero for <.> + static member inline IsZipLeftZero (t: ref<'``Alternative<'T>``> , _mthd: Default2) = (t.Value = Empty.InvokeOnInstance ()) + + static member inline IsZipLeftZero (t: ref<'``ZipApplicative<'T>``> , _mthd: Default1) = (^``ZipApplicative<'T>`` : (static member IsZipLeftZero : _ -> _) t.Value) + static member inline IsZipLeftZero (_: ref< ^t> when ^t: null and ^t: struct, _: Default1) = () + +#endif diff --git a/src/FSharpPlus/Data/Monoids.fs b/src/FSharpPlus/Data/Monoids.fs index 8c4e637fa..5d4cef0d5 100644 --- a/src/FSharpPlus/Data/Monoids.fs +++ b/src/FSharpPlus/Data/Monoids.fs @@ -180,15 +180,15 @@ type Compose<'``functorF<'functorG<'t>>``> = Compose of '``functorF<'functorG<'t static member inline get_Empty () = Compose (getEmpty ()) : Compose<'``AlternativeF<'ApplicativeG<'T>``> static member inline (<|>) (Compose x, Compose y) = Compose (x <|> y) : Compose<'``AlternativeF<'ApplicativeG<'T>``> - // Parallel Applicative - static member inline () (Compose (f: '``ApplicativeF<'ApplicativeG<'T->'U>``), Compose (x: '``ApplicativeF<'ApplicativeG<'T>``)) = - Compose (((() : '``ApplicativeG<'T->'U>`` -> '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>``) f: '``ApplicativeF<'ApplicativeG<'T>->'ApplicativeG<'U>`` ) x: '``ApplicativeF<'ApplicativeG<'U>``) + // ZipApplicative + static member inline (<.>) (Compose (f: '``ApplicativeF<'ApplicativeG<'T->'U>``), Compose (x: '``ApplicativeF<'ApplicativeG<'T>``)) = + Compose ((((<.>) : '``ApplicativeG<'T->'U>`` -> '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>``) f: '``ApplicativeF<'ApplicativeG<'T>->'ApplicativeG<'U>`` ) <.> x: '``ApplicativeF<'ApplicativeG<'U>``) - static member inline ParLift2 (f: 'T -> 'U -> 'V, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``)) = - Compose (ParLift2.Invoke (ParLift2.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>``) x y: '``ApplicativeF<'ApplicativeG<'V>``) + static member inline Map2 (f: 'T -> 'U -> 'V, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``)) = + Compose (Map2.Invoke (Map2.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>``) x y: '``ApplicativeF<'ApplicativeG<'V>``) - static member inline ParLift3 (f: 'T -> 'U -> 'V -> 'W, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``), Compose (z: '``ApplicativeF<'ApplicativeG<'V>``)) = - Compose (ParLift3.Invoke (ParLift3.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>`` -> '``ApplicativeG<'W>``) x y z: '``ApplicativeF<'ApplicativeG<'W>``) + static member inline Map3 (f: 'T -> 'U -> 'V -> 'W, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``), Compose (z: '``ApplicativeF<'ApplicativeG<'V>``)) = + Compose (Map3.Invoke (Map3.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>`` -> '``ApplicativeG<'W>``) x y z: '``ApplicativeF<'ApplicativeG<'W>``) /// Basic operations on Compose [] diff --git a/src/FSharpPlus/Data/NonEmptyList.fs b/src/FSharpPlus/Data/NonEmptyList.fs index ad7ae542b..9c9e5bbfb 100644 --- a/src/FSharpPlus/Data/NonEmptyList.fs +++ b/src/FSharpPlus/Data/NonEmptyList.fs @@ -149,16 +149,16 @@ module NonEmptyList = let inline sequence (source: NonEmptyList<'``Functor<'T>``>) : '``Functor>`` = traverse id source /// - /// Maps each element of the list to an action, evaluates these actions from left to right, pointwise, and/or in parallel, and collect the results. + /// Maps each element of the list to an action, evaluates these actions from left to right, pointwise, and/or in parallel then collect results. /// - let inline ptraverse (f: 'T -> '``Functor<'U>``) (source: NonEmptyList<'T>) = - ParSequence.ForInfiniteSequences (Seq.map f source, IsParLeftZero.Invoke, ofList, fun _ -> invalidOp "Unreacheable code.") + let inline gather (f: 'T -> '``ZipFunctor<'U>``) (source: NonEmptyList<'T>) = + Transpose.ForInfiniteSequences (Seq.map f source, IsZipLeftZero.Invoke, ofList, fun _ -> invalidOp "Unreacheable code.") /// - /// Evaluates each action in the list from left to right, pointwise, and/or in parallel and collect the results. + /// Evaluates each action in the list from left to right, pointwise, and/or in parallel then collect results. /// - let inline psequence (source: NonEmptyList<'``Functor<'T>``>) : '``Functor>`` = - ParSequence.ForInfiniteSequences (source, IsParLeftZero.Invoke, ofList, fun _ -> invalidOp "Unreacheable code.") + let inline transpose (source: NonEmptyList<'``ZipFunctor<'T>``>) : '``Functor>`` = + Transpose.ForInfiniteSequences (source, IsZipLeftZero.Invoke, ofList, fun _ -> invalidOp "Unreacheable code.") #endif @@ -263,17 +263,17 @@ type NonEmptyList<'t> with let r = NonEmptyList.toList f NonEmptyList.toList x {Head = r.Head; Tail = r.Tail} - static member ParReturn (x: 'a) = { Head = x; Tail = List.cycle [x] } - static member () (f: NonEmptyList<'T->'U>, x: NonEmptyList<'T>) = NonEmptyList.map2Shortest (<|) f x + static member Pure (x: 'a) = { Head = x; Tail = List.cycle [x] } + static member (<.>) (f: NonEmptyList<'T->'U>, x: NonEmptyList<'T>) = NonEmptyList.map2Shortest (<|) f x static member Lift2 (f: 'T -> 'U -> 'V, x, y) = NonEmptyList.ofList (List.lift2 f (NonEmptyList.toList x) (NonEmptyList.toList y)) static member Lift3 (f: 'T -> 'U -> 'V -> 'W, x, y, z) = NonEmptyList.ofList (List.lift3 f (NonEmptyList.toList x) (NonEmptyList.toList y) (NonEmptyList.toList z)) [] - static member ParLift2 (f: 'T -> 'U -> 'V, x, y) = NonEmptyList.map2Shortest f x y + static member Map2 (f: 'T -> 'U -> 'V, x, y) = NonEmptyList.map2Shortest f x y [] - static member ParLift3 (f: 'T -> 'U -> 'V -> 'W, x, y, z) = NonEmptyList.map3Shortest f x y z + static member Map3 (f: 'T -> 'U -> 'V -> 'W, x, y, z) = NonEmptyList.map3Shortest f x y z static member Extract {Head = h; Tail = _} = h : 't @@ -304,10 +304,10 @@ type NonEmptyList<'t> with static member inline Sequence (s: NonEmptyList<'``Functor<'T>``>) : '``Functor>`` = NonEmptyList.sequence s [] - static member inline ParTraverse (s: NonEmptyList<'T>, f: 'T -> '``Functor<'U>``) : '``Functor>`` = NonEmptyList.ptraverse f s + static member inline Gather (s: NonEmptyList<'T>, f: 'T -> '``Functor<'U>``) : '``Functor>`` = NonEmptyList.gather f s [] - static member inline ParSequence (s: NonEmptyList<'``Functor<'T>``>) : '``Functor>`` = NonEmptyList.psequence s + static member inline Transpose (s: NonEmptyList<'``Functor<'T>``>) : '``Functor>`` = NonEmptyList.transpose s static member Replace (source: NonEmptyList<'T>, oldValue: NonEmptyList<'T>, newValue: NonEmptyList<'T>, _impl: Replace ) = let lst = source |> NonEmptyList.toSeq |> Seq.replace oldValue newValue |> Seq.toList diff --git a/src/FSharpPlus/Extensions/Async.fs b/src/FSharpPlus/Extensions/Async.fs index 71f918b45..93be71b0d 100644 --- a/src/FSharpPlus/Extensions/Async.fs +++ b/src/FSharpPlus/Extensions/Async.fs @@ -10,36 +10,36 @@ module Async = let map f x = async.Bind (x, async.Return << f) /// Creates an async workflow from two workflows 'x' and 'y', mapping its results with 'f'. - /// Workflows are run in sequence, for parallel use pmap2. + /// Workflows are run in sequence. /// The mapping function. /// First async workflow. /// Second async workflow. - let map2 f x y = async { + let lift2 f x y = async { let! a = x let! b = y return f a b} /// Creates an async workflow from three workflows 'x', 'y' and 'z', mapping its results with 'f'. - /// Workflows are run in sequence, for parallel use pmap3. + /// Workflows are run in sequence. /// The mapping function. /// First async workflow. /// Second async workflow. /// third async workflow. - let map3 f x y z = async { + let lift3 f x y z = async { let! a = x let! b = y let! c = z return f a b c} /// Creates an async workflow from two workflows 'x' and 'y', mapping its results with 'f'. - /// Similar to map2 but workflows are run in parallel. + /// Similar to lift2 but although workflows are started in sequence they might end independently in different order. /// The mapping function. /// First async workflow. /// Second async workflow. #if FABLE_COMPILER - let pmap2 f x y = map2 f x y + let map2 f x y = lift2 f x y #else - let pmap2 f x y = async { + let map2 f x y = async { let! ct = Async.CancellationToken let x = Async.StartImmediateAsTask (x, ct) let y = Async.StartImmediateAsTask (y, ct) @@ -49,15 +49,15 @@ module Async = #endif /// Creates an async workflow from three workflows 'x', 'y' and 'z', mapping its results with 'f'. - /// Similar to map3 but workflows are run in parallel. + /// Similar to lift3 but although workflows are started in sequence they might end independently in different order. /// The mapping function. /// First async workflow. /// Second async workflow. /// third async workflow. #if FABLE_COMPILER - let pmap3 f x y z = map3 f x y z + let map3 f x y z = lift3 f x y z #else - let pmap3 f x y z = async { + let map3 f x y z = async { let! ct = Async.CancellationToken let x = Async.StartImmediateAsTask (x, ct) let y = Async.StartImmediateAsTask (y, ct) @@ -69,11 +69,25 @@ module Async = #endif /// Creates an async workflow from two workflows 'x' and 'y', tupling its results. - let zip x y = async { + let zipSequentially x y = async { let! a = x let! b = y return a, b} + /// Creates an async workflow from two workflows 'x' and 'y', tupling its results. + /// Similar to zipSequentially but although workflows are started in sequence they might end independently in different order. + #if FABLE_COMPILER + let zip x y = zipSequentially x y + #else + let zip x y = async { + let! ct = Async.CancellationToken + let x = Async.StartImmediateAsTask (x, ct) + let y = Async.StartImmediateAsTask (y, ct) + let! x' = Async.AwaitTask x + let! y' = Async.AwaitTask y + return x', y' } + #endif + /// Flatten two nested asyncs into one. let join x = async.Bind (x, id) diff --git a/src/FSharpPlus/Extensions/Task.fs b/src/FSharpPlus/Extensions/Task.fs index 1b87d8653..666aab75d 100644 --- a/src/FSharpPlus/Extensions/Task.fs +++ b/src/FSharpPlus/Extensions/Task.fs @@ -45,7 +45,7 @@ module Task = /// The mapping function. /// First task workflow. /// Second task workflow. - let map2 (f: 'T -> 'U -> 'V) (x: Task<'T>) (y: Task<'U>) : Task<'V> = + let lift2 (f: 'T -> 'U -> 'V) (x: Task<'T>) (y: Task<'U>) : Task<'V> = if x.Status = TaskStatus.RanToCompletion && y.Status = TaskStatus.RanToCompletion then try Task.FromResult (f x.Result y.Result) with e -> @@ -97,7 +97,7 @@ module Task = /// First task workflow. /// Second task workflow. /// Third task workflow. - let map3 (f : 'T -> 'U -> 'V -> 'W) (x : Task<'T>) (y : Task<'U>) (z: Task<'V>) : Task<'W> = + let lift3 (f : 'T -> 'U -> 'V -> 'W) (x : Task<'T>) (y : Task<'U>) (z: Task<'V>) : Task<'W> = if x.Status = TaskStatus.RanToCompletion && y.Status = TaskStatus.RanToCompletion && z.Status = TaskStatus.RanToCompletion then try Task.FromResult (f x.Result y.Result z.Result) with e -> @@ -135,22 +135,22 @@ module Task = tcs.Task /// Creates a task workflow from two workflows 'x' and 'y', mapping its results with 'f'. - /// Similar to map2 but workflows are run in parallel. + /// Similar to lift2 but although workflows are started in sequence they might end independently in different order. /// The mapping function. /// First task workflow. /// Second task workflow. - let pmap2 f x y = task { + let map2 f x y = task { let! x' = x let! y' = y return f x' y' } /// Creates a task workflow from three workflows 'x', 'y' and z, mapping its results with 'f'. - /// Similar to map2 but workflows are run in parallel. + /// Similar to lift3 but although workflows are started in sequence they might end independently in different order. /// The mapping function. /// First task workflow. /// Second task workflow. /// Third task workflow. - let pmap3 f x y z = task { + let map3 f x y z = task { let! x' = x let! y' = y let! z' = z @@ -207,7 +207,7 @@ module Task = tcs.Task /// Creates a task workflow from two workflows 'x' and 'y', tupling its results. - let zip (x: Task<'T>) (y: Task<'U>) : Task<'T * 'U> = + let zipSequentially (x: Task<'T>) (y: Task<'U>) : Task<'T * 'U> = if x.Status = TaskStatus.RanToCompletion && y.Status = TaskStatus.RanToCompletion then Task.FromResult (x.Result, y.Result) else @@ -241,6 +241,13 @@ module Task = | Completed r' -> tcs.SetResult (r, r')) |> ignore) |> ignore tcs.Task + /// Creates a task workflow from two workflows 'x' and 'y', tupling its results. + /// Similar to zipSequentially but although workflows are started in sequence they might end independently in different order. + let zip x y = task { + let! x' = x + let! y' = y + return x', y' } + /// Flattens two nested tasks into one. let join (source: Task>) : Task<'T> = source.Unwrap() diff --git a/src/FSharpPlus/Extensions/ValueTask.fs b/src/FSharpPlus/Extensions/ValueTask.fs index 669470975..b2f8b3299 100644 --- a/src/FSharpPlus/Extensions/ValueTask.fs +++ b/src/FSharpPlus/Extensions/ValueTask.fs @@ -39,7 +39,7 @@ module ValueTask = /// The mapping function. /// First ValueTask workflow. /// Second ValueTask workflow. - let map2 (f: 'T -> 'U -> 'V) (x: ValueTask<'T>) (y: ValueTask<'U>) : ValueTask<'V> = + let lift2 (f: 'T -> 'U -> 'V) (x: ValueTask<'T>) (y: ValueTask<'U>) : ValueTask<'V> = let tcs = TaskCompletionSource<'V> () continueTask tcs x (fun x -> continueTask tcs y (fun y -> @@ -53,7 +53,7 @@ module ValueTask = /// First ValueTask workflow. /// Second ValueTask workflow. /// Third ValueTask workflow. - let map3 (f: 'T -> 'U -> 'V -> 'W) (x: ValueTask<'T>) (y: ValueTask<'U>) (z: ValueTask<'V>) : ValueTask<'W> = + let lift3 (f: 'T -> 'U -> 'V -> 'W) (x: ValueTask<'T>) (y: ValueTask<'U>) (z: ValueTask<'V>) : ValueTask<'W> = let tcs = TaskCompletionSource<'W> () continueTask tcs x (fun x -> continueTask tcs y (fun y -> @@ -63,12 +63,12 @@ module ValueTask = tcs.Task |> ValueTask<'W> /// Creates a task workflow from two workflows 'x' and 'y', mapping its results with 'f'. - /// Similar to map2 but workflows are run in parallel. + /// Similar to lift2 but although workflows are started in sequence they might end independently in different order. /// The mapping function. /// First ValueTask workflow. /// Second ValueTask workflow. /// Third ValueTask workflow. - let pmap2 (f: 'T -> 'U -> 'V) (x: ValueTask<'T>) (y: ValueTask<'U>) : ValueTask<'V> = + let map2 (f: 'T -> 'U -> 'V) (x: ValueTask<'T>) (y: ValueTask<'U>) : ValueTask<'V> = task { let! x' = x let! y' = y @@ -77,12 +77,12 @@ module ValueTask = |> ValueTask<'V> /// Creates a ValueTask workflow from three workflows 'x', 'y' and z, mapping its results with 'f'. - /// Similar to map3 but workflows are run in parallel. + /// Similar to lift3 but although workflows are started in sequence they might end independently in different order. /// The mapping function. /// First ValueTask workflow. /// Second ValueTask workflow. /// Third ValueTask workflow. - let pmap3 (f: 'T -> 'U -> 'V -> 'W) (x: ValueTask<'T>) (y: ValueTask<'U>) (z: ValueTask<'V>) : ValueTask<'W> = + let map3 (f: 'T -> 'U -> 'V -> 'W) (x: ValueTask<'T>) (y: ValueTask<'U>) (z: ValueTask<'V>) : ValueTask<'W> = task { let! x' = x let! y' = y @@ -104,12 +104,22 @@ module ValueTask = tcs.Task |> ValueTask<'U> /// Creates a ValueTask workflow from two workflows 'x' and 'y', tupling its results. - let zip (x: ValueTask<'T>) (y: ValueTask<'U>) : ValueTask<'T * 'U> = + let zipSequentially (x: ValueTask<'T>) (y: ValueTask<'U>) : ValueTask<'T * 'U> = let tcs = TaskCompletionSource<'T * 'U> () continueTask tcs x (fun x -> continueTask tcs y (fun y -> tcs.SetResult (x, y))) tcs.Task |> ValueTask<'T * 'U> + + /// Creates a ValueTask workflow from two workflows 'x' and 'y', tupling its results. + /// Similar to zipSequentially but although workflows are started in sequence they might end independently in different order. + let zip (x: ValueTask<'T>) (y: ValueTask<'U>) : ValueTask<'T * 'U> = + task { + let! x' = x + let! y' = y + return x', y' + } + |> ValueTask<'T * 'U> /// Flattens two nested ValueTask into one. let join (source: ValueTask>) : ValueTask<'T> = diff --git a/src/FSharpPlus/FSharpPlus.fsproj b/src/FSharpPlus/FSharpPlus.fsproj index f748b533d..3e8b0704d 100644 --- a/src/FSharpPlus/FSharpPlus.fsproj +++ b/src/FSharpPlus/FSharpPlus.fsproj @@ -66,7 +66,7 @@ - + diff --git a/src/FSharpPlus/Math/Applicative.fs b/src/FSharpPlus/Math/Applicative.fs index 790822718..ad781f40f 100644 --- a/src/FSharpPlus/Math/Applicative.fs +++ b/src/FSharpPlus/Math/Applicative.fs @@ -64,57 +64,57 @@ module Applicative = let inline ( >=. ) (x: 'T) (y: '``Functor<'T>``) = map ((>=) x) y : '``Functor`` let inline ( .>=. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (>=) x <*> y : '``Applicative`` -/// Math Operators ready to use over (parallel) Applicative Functors. -module ParallelApplicative = +/// Math Operators ready to use over (non sequential) Applicative Functors. +module ZipApplicative = let inline ( ~-. ) (x: '``Functor<'T>``) = map ((~-)) x : '``Functor<'T>`` let inline ( .+ ) (x: '``Functor<'T>``) (y: 'T) = map ((+)/> y) x : '``Functor<'T>`` let inline ( +. ) (x: 'T) (y: '``Functor<'T>``) = map ((+) x) y : '``Functor<'T>`` - let inline ( .+. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (+) x y : '``Applicative<'T>`` + let inline ( .+. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (+) x <.> y : '``Applicative<'T>`` let inline ( .- ) (x: '``Functor<'T>``) (y: 'T) = map ((-)/> y) x : '``Functor<'T>`` let inline ( -. ) (x: 'T) (y: '``Functor<'T>``) = map ((-) x) y : '``Functor<'T>`` - let inline ( .-. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (-) x y : '``Applicative<'T>`` + let inline ( .-. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (-) x <.> y : '``Applicative<'T>`` let inline ( .* ) (x: '``Functor<'T>``) (y: 'T) = map ((*)/> y) x : '``Functor<'T>`` let inline ( *. ) (x: 'T) (y: '``Functor<'T>``) = map ((*) x) y : '``Functor<'T>`` - let inline ( .*. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (*) x y : '``Applicative<'T>`` + let inline ( .*. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (*) x <.> y : '``Applicative<'T>`` let inline ( .% ) (x: '``Functor<'T>``) (y: 'T) = map ((%)/> y) x : '``Functor<'T>`` let inline ( %. ) (x: 'T) (y: '``Functor<'T>``) = map ((%) x) y : '``Functor<'T>`` - let inline ( .%. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (%) x y : '``Applicative<'T>`` + let inline ( .%. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (%) x <.> y : '``Applicative<'T>`` let inline ( ./ ) (x: '``Functor<'T>``) (y: 'T) = map ((/)/> y) x : '``Functor<'T>`` let inline ( /. ) (x: 'T) (y: '``Functor<'T>``) = map ((/) x) y : '``Functor<'T>`` - let inline ( ./. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (/) x y : '``Applicative<'T>`` + let inline ( ./. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (/) x <.> y : '``Applicative<'T>`` let inline ( .= ) (x: '``Functor<'T>``) (y: 'T) = map ((=)/> y) x : '``Functor`` let inline ( =. ) (x: 'T) (y: '``Functor<'T>``) = map ((=) x) y : '``Functor`` - let inline ( .=. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (=) x y : '``Applicative`` + let inline ( .=. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (=) x <.> y : '``Applicative`` let inline ( .> ) (x: '``Functor<'T>``) (y: 'T) = map ((>)/> y) x : '``Functor`` let inline ( >. ) (x: 'T) (y: '``Functor<'T>``) = map ((>) x) y : '``Functor`` - let inline ( .>. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (>) x y : '``Applicative`` + let inline ( .>. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (>) x <.> y : '``Applicative`` let inline ( .< ) (x: '``Functor<'T>``) (y: 'T) = map ((<)/> y) x : '``Functor`` let inline ( <. ) (x: 'T) (y: '``Functor<'T>``) = map ((<) x) y : '``Functor`` - let inline ( .<. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (<) x y : '``Applicative`` + let inline ( .<. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (<) x <.> y : '``Applicative`` let inline (.|| ) (x: '``Functor``) (y: bool) = map ((||)/> y) x : '``Functor`` let inline ( ||.) (x: bool) (y: '``Functor``) = map ((||) x) y : '``Functor`` - let inline (.||.) (x: '``Applicative``) (y: '``Applicative``) = (||) x y : '``Applicative`` + let inline (.||.) (x: '``Applicative``) (y: '``Applicative``) = (||) x <.> y : '``Applicative`` let inline (.&& ) (x: '``Functor``) (y: bool) = map ((&&)/> y) x : '``Functor`` let inline ( &&.) (x: bool) (y: '``Functor``) = map ((&&) x) y : '``Functor`` - let inline (.&&.) (x: '``Applicative``) (y: '``Applicative``) = (&&) x y : '``Applicative`` + let inline (.&&.) (x: '``Applicative``) (y: '``Applicative``) = (&&) x <.> y : '``Applicative`` let inline ( .<= ) (x: '``Functor<'T>``) (y: 'T) = map ((<=)/> y) x : '``Functor`` let inline ( <=. ) (x: 'T) (y: '``Functor<'T>``) = map ((<=) x) y : '``Functor`` - let inline ( .<=. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (<=) x y : '``Applicative`` + let inline ( .<=. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (<=) x <.> y : '``Applicative`` let inline ( .>= ) (x: '``Functor<'T>``) (y: 'T) = map ((>=)/> y) x : '``Functor`` let inline ( >=. ) (x: 'T) (y: '``Functor<'T>``) = map ((>=) x) y : '``Functor`` - let inline ( .>=. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (>=) x y : '``Applicative`` + let inline ( .>=. ) (x: '``Applicative<'T>``) (y: '``Applicative<'T>``) = (>=) x <.> y : '``Applicative`` #endif \ No newline at end of file diff --git a/src/FSharpPlus/Operators.fs b/src/FSharpPlus/Operators.fs index 69c778049..af10987cf 100644 --- a/src/FSharpPlus/Operators.fs +++ b/src/FSharpPlus/Operators.fs @@ -176,7 +176,7 @@ module Operators = /// Apply a lifted argument to a lifted function: f <*> arg /// /// Applicative - let inline (<*>) (f: '``Applicative<'T -> 'U>``) (x: '``Applicative<'T>``) : '``Applicative<'U>`` = Apply.Invoke f x : '``Applicative<'U>`` + let inline (<*>) (f: '``Applicative<'T -> 'U>``) (x: '``Applicative<'T>``) : '``Applicative<'U>`` = Apply.Invoke f x : '``Applicative<'U>`` /// /// Applies 2 lifted arguments to a non-lifted function. Equivalent to map2 in non list-like types. @@ -220,29 +220,29 @@ module Operators = /// - /// Lifts a value into a Functor. Same as return in Computation Expressions. + /// Lifts a value into a ZipFunctor. Same as return in (zip) Computation Expressions. /// /// Applicative - let inline presult (x: 'T) : '``Functor<'T>`` = ParReturn.Invoke x + let inline pur (x: 'T) : '``ZipFunctor<'T>`` = Pure.Invoke x /// /// Apply a lifted argument to a lifted function: f </> arg. - /// Same as <*> but for parallel applicatives. + /// Same as <*> but for non sequential applicatives. /// /// Applicative - let inline () (f: '``Applicative<'T -> 'U>``) (x: '``Applicative<'T>``) : '``Applicative<'U>`` = ParApply.Invoke f x : '``Applicative<'U>`` + let inline (<.>) (f: '``ZipApplicative<'T -> 'U>``) (x: '``ZipApplicative<'T>``) : '``ZipApplicative<'U>`` = ZipApply.Invoke f x : '``ZipApplicative<'U>`` /// - /// Applies 2 lifted arguments to a non-lifted function with parallel semantics. + /// Applies 2 lifted arguments to a non-lifted function with pointwise and/or parallel semantics. /// /// Applicative - let inline plift2 (f: 'T->'U->'V) (x: '``Applicative<'T>``) (y: '``Applicative<'U>``) : '``Applicative<'V>`` = ParLift2.Invoke f x y + let inline map2 (f: 'T->'U->'V) (x: '``ZipApplicative<'T>``) (y: '``ZipApplicative<'U>``) : '``ZipApplicative<'V>`` = Map2.Invoke f x y /// - /// Applies 3 lifted arguments to a non-lifted function with parallel semantics. + /// Applies 3 lifted arguments to a non-lifted function with pointwise and/or parallel semantics. /// /// Applicative - let inline plift3 (f: 'T->'U->'V->'W) (x: '``Applicative<'T>``) (y: '``Applicative<'U>``) (z: '``Applicative<'V>``) : '``Applicative<'W>`` = ParLift3.Invoke f x y z + let inline map3 (f: 'T->'U->'V->'W) (x: '``ZipApplicative<'T>``) (y: '``ZipApplicative<'U>``) (z: '``ZipApplicative<'V>``) : '``ZipApplicative<'W>`` = Map3.Invoke f x y z @@ -723,20 +723,20 @@ module Operators = /// Traversable let inline sequence (t: '``Traversable<'Functor<'T>>``) : '``Functor<'Traversable<'T>>`` = Sequence.Invoke t - + // Traversable (Parallel / Pointwise) /// - /// Map each element of a structure to an action, evaluate these actions from left to right, pointwise, or in parallel, and collect the results. + /// Map each element of a structure to an action, evaluate these actions from left to right, pointwise, and/or in parallel, and collect the results. /// /// Traversable - let inline ptraverse (f: 'T->'``Functor<'U>``) (t: '``Traversable<'T>``) : '``Functor<'Traversable<'U>>`` = ParTraverse.Invoke f t + let inline gather (f: 'T->'``ZipFunctor<'U>``) (t: '``Traversable<'T>``) : '``ZipFunctor<'Traversable<'U>>`` = Gather.Invoke f t /// - /// Evaluate each action in the structure from left to right, pointwise, or in parallel, and collect the results. + /// Evaluate each action in the structure from left to right, pointwise, and/or in parallel, and collect the results. /// /// Traversable - let inline psequence (t: '``Traversable<'Functor<'T>>``) : '``Functor<'Traversable<'T>>`` = ParSequence.Invoke t + let inline transpose (t: '``Traversable<'ZipFunctor<'T>>``) : '``ZipFunctor<'Traversable<'T>>`` = Transpose.Invoke t // Bifoldable diff --git a/tests/FSharpPlus.Tests/Applicatives.fs b/tests/FSharpPlus.Tests/Applicatives.fs index d9269a8c6..4cb1473ab 100644 --- a/tests/FSharpPlus.Tests/Applicatives.fs +++ b/tests/FSharpPlus.Tests/Applicatives.fs @@ -10,17 +10,17 @@ open Helpers module Applicatives = [] - let presultAndParApply () = + let pureAndZipApply () = let res9n5 = map ((+) 1) [8;4] CollectionAssert.AreEqual ([9; 5], res9n5) - let red20n30 = presult (+) presult 10 NonEmptySeq.ofList [10;20] + let red20n30 = pur (+) <.> pur 10 <.> NonEmptySeq.ofList [10;20] CollectionAssert.AreEqual (NonEmptySeq.ofList [20; 30], red20n30) [] - let parApply () = - let arr1 = par2 { + let zipApply () = + let arr1 = zapp2 { let! x1 = async { return [|1; 2; 3|] } and! x2 = async { return [|10; 20; 30|] } and! x3 = async { return [|100; 200; 300|] } @@ -28,8 +28,8 @@ module Applicatives = return x1 + x2 + x3 + x4 } CollectionAssert.AreEqual ([|1111; 2222; 3333|], arr1 |> Async.RunSynchronously) - let arr2 = (+) [|1;2;3|] [|10;20;30|] + let arr2 = (+) [|1;2;3|] <.> [|10;20;30|] CollectionAssert.AreEqual ([|11; 22; 33|], arr2) - let arr3 = (+) Compose (async { return [|1;2;3|] } ) Compose (async { return [|10;20;30|] }) + let arr3 = (+) Compose (async { return [|1;2;3|] } ) <.> Compose (async { return [|10;20;30|] }) CollectionAssert.AreEqual ([|11; 22; 33|], arr3 |> Compose.run |> Async.RunSynchronously) diff --git a/tests/FSharpPlus.Tests/Extensions.fs b/tests/FSharpPlus.Tests/Extensions.fs index dfd5809c6..1ddc7b33a 100644 --- a/tests/FSharpPlus.Tests/Extensions.fs +++ b/tests/FSharpPlus.Tests/Extensions.fs @@ -385,10 +385,10 @@ module Extensions = Choice.map3 (fun x y z -> x + y + z) (result 1: Choice) (result 3) (throw 5) |> areEqual (throw 5: Choice) // Async - Async.map3 (fun x y z -> x + y + z) (async {return 1}) (async {return 3}) (async {return 5}) |> Async.RunSynchronously |> areEqual 9 + Async.lift3 (fun x y z -> x + y + z) (async {return 1}) (async {return 3}) (async {return 5}) |> Async.RunSynchronously |> areEqual 9 // Task - Task.map3 (fun x y z -> x + y + z) (async {return 1} |> Async.StartAsTask) (async {return 3} |> Async.StartAsTask) (async {return 5} |> Async.StartAsTask) + Task.lift3 (fun x y z -> x + y + z) (async {return 1} |> Async.StartAsTask) (async {return 3} |> Async.StartAsTask) (async {return 5} |> Async.StartAsTask) |> Async.AwaitTask |> Async.RunSynchronously |> areEqual 9 // List diff --git a/tests/FSharpPlus.Tests/Task.fs b/tests/FSharpPlus.Tests/Task.fs index 1f82b29a0..e9c5e62aa 100644 --- a/tests/FSharpPlus.Tests/Task.fs +++ b/tests/FSharpPlus.Tests/Task.fs @@ -36,14 +36,14 @@ module Task = let a = Task.map string x1 require a.IsCompleted "Task.map didn't short-circuit" - let b = Task.zip x1 x2 - require b.IsCompleted "Task.zip didn't short-circuit" + let b = Task.zipSequentially x1 x2 + require b.IsCompleted "Task.zipSequentially didn't short-circuit" - let c = Task.map2 (+) x1 x2 - require c.IsCompleted "Task.map2 didn't short-circuit" + let c = Task.lift2 (+) x1 x2 + require c.IsCompleted "Task.lift2 didn't short-circuit" - let d = Task.map3 (fun x y z -> x + y + z) x1 x2 x3 - require d.IsCompleted "Task.map3 didn't short-circiut" + let d = Task.lift3 (fun x y z -> x + y + z) x1 x2 x3 + require d.IsCompleted "Task.lift3 didn't short-circiut" [] let erroredTasks () = @@ -71,16 +71,16 @@ module Task = let r02 = Task.map (mapping true) (x1 ()) r02.Exception.InnerExceptions |> areEquivalent [TestException "I was told to fail"] - let r03 = Task.zip (e1 ()) (x2 ()) + let r03 = Task.zipSequentially (e1 ()) (x2 ()) r03.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"] - let r04 = Task.zip (e1 ()) (e2 ()) + let r04 = Task.zipSequentially (e1 ()) (e2 ()) r04.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"] - let r05 = Task.map2 (mapping2 false) (e1 ()) (x2 ()) + let r05 = Task.lift2 (mapping2 false) (e1 ()) (x2 ()) r05.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"] - let r06 = Task.map2 (mapping2 false) (e1 ()) (e2 ()) + let r06 = Task.lift2 (mapping2 false) (e1 ()) (e2 ()) r06.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"] let r07 = Task.bind (binding true) (e1 ()) @@ -139,17 +139,17 @@ module Task = | AggregateException [e] -> failwithf "Something else came in: %A" e | AggregateException e -> failwithf "Many errors came in: %A" e - let r15 = Task.map3 (mapping3 false) (e1 ()) (e2 ()) (e3 ()) + let r15 = Task.lift3 (mapping3 false) (e1 ()) (e2 ()) (e3 ()) r15.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"] - let r16 = Task.map3 (mapping3 false) (e1 ()) (x2 ()) (e3 ()) + let r16 = Task.lift3 (mapping3 false) (e1 ()) (x2 ()) (e3 ()) r16.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"] - let r17 = Task.map3 (mapping3 false) (e1 ()) (e2 ()) (x3 ()) + let r17 = Task.lift3 (mapping3 false) (e1 ()) (e2 ()) (x3 ()) r17.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"] - let r18 = Task.map3 (mapping3 false) (e1 ()) (x2 ()) (x3 ()) + let r18 = Task.lift3 (mapping3 false) (e1 ()) (x2 ()) (x3 ()) r18.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 1"] - let r19 = Task.map3 (mapping3 false) (x1 ()) (e2 ()) (e3 ()) + let r19 = Task.lift3 (mapping3 false) (x1 ()) (e2 ()) (e3 ()) r19.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 2"] - let r20 = Task.map3 (mapping3 false) (x1 ()) (x2 ()) (e3 ()) + let r20 = Task.lift3 (mapping3 false) (x1 ()) (x2 ()) (e3 ()) r20.Exception.InnerExceptions |> areEquivalent [TestException "Ouch, can't create: 3"] module TaskBuilderTests = From a5a3a749420e1535767456b1d03aa6d12b6f2362 Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Thu, 25 Jan 2024 08:24:36 +0100 Subject: [PATCH 20/27] Use non-seq Zip for computations --- src/FSharpPlus/Control/Functor.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/FSharpPlus/Control/Functor.fs b/src/FSharpPlus/Control/Functor.fs index f33218683..2058fd069 100644 --- a/src/FSharpPlus/Control/Functor.fs +++ b/src/FSharpPlus/Control/Functor.fs @@ -219,12 +219,12 @@ type Zip = static member Zip ((x: option<'T> , y: option<'U> , _output: option<'T*'U> ), _mthd: Zip) = Option.zip x y static member Zip ((x: voption<'T> , y: voption<'U> , _output: voption<'T*'U> ), _mthd: Zip) = ValueOption.zip x y static member Zip ((x: Result<'T, 'Error> , y: Result<'U, 'Error> , _output: Result<'T * 'U, 'Error> ), _mthd: Zip) = Result.zip x y - static member Zip ((x: Async<'T> , y: Async<'U> , _output: Async<'T*'U> ), _mthd: Zip) = Async.zipSequentially x y + static member Zip ((x: Async<'T> , y: Async<'U> , _output: Async<'T*'U> ), _mthd: Zip) = Async.zip x y #if !FABLE_COMPILER - static member Zip ((x: Task<'T> , y: Task<'U> , _output: Task<'T*'U> ), _mthd: Zip) = Task.zipSequentially x y + static member Zip ((x: Task<'T> , y: Task<'U> , _output: Task<'T*'U> ), _mthd: Zip) = Task.zip x y #endif #if !NET45 && !NETSTANDARD2_0 && !FABLE_COMPILER - static member Zip ((x: ValueTask<'T> , y: ValueTask<'U> , _output: ValueTask<'T*'U> ), _mthd: Zip) = ValueTask.zipSequentially x y + static member Zip ((x: ValueTask<'T> , y: ValueTask<'U> , _output: ValueTask<'T*'U> ), _mthd: Zip) = ValueTask.zip x y #endif static member inline Invoke (source1: '``ZipFunctor<'T1>``) (source2: '``ZipFunctor<'T2>``) = From 714aa5acc7e531d968f20e24166cded0088acde5 Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Thu, 25 Jan 2024 08:39:55 +0100 Subject: [PATCH 21/27] + Instances for Validation --- src/FSharpPlus/Control/Monoid.fs | 6 ++++-- src/FSharpPlus/Data/Validation.fs | 26 ++++++++++++++++++++++++++ 2 files changed, 30 insertions(+), 2 deletions(-) diff --git a/src/FSharpPlus/Control/Monoid.fs b/src/FSharpPlus/Control/Monoid.fs index 2c855d3b4..145a8341b 100644 --- a/src/FSharpPlus/Control/Monoid.fs +++ b/src/FSharpPlus/Control/Monoid.fs @@ -34,13 +34,15 @@ type Plus = static member ``+`` (x: AggregateException, y: AggregateException, []_mthd: Plus ) = new AggregateException (seq {yield! x.InnerExceptions; yield! y.InnerExceptions}) static member ``+`` (x: exn , y: exn , []_mthd: Plus ) = let f (e: exn) = match e with :? AggregateException as a -> a.InnerExceptions :> seq<_> | _ -> Seq.singleton e - new AggregateException (seq {yield! f x; yield! f y}) :> exn + let left = f x + new AggregateException (seq { yield! left; yield! Seq.except left (f y) }) :> exn #else static member ``+`` (x: StringBuilder , y: StringBuilder , []_mthd: Plus ) = StringBuilder().Append(string x).Append(string y) static member ``+`` (_: Id0 , _: Id0 , []_mthd: Plus ) = Id0 "" static member ``+`` (x: exn , y: exn , []_mthd: Plus ) : exn = let f (e: exn) = match e with :? AggregateException as a -> a.Data0 :> seq<_> | _ -> Seq.singleton e - AggregateException (seq {yield! f x; yield! f y}) + let left = f x + AggregateException (seq { yield! left; yield! Seq.except left (f y) }) :> exn #endif static member inline Invoke (x: 'Plus) (y: 'Plus) : 'Plus = diff --git a/src/FSharpPlus/Data/Validation.fs b/src/FSharpPlus/Data/Validation.fs index 4cc176805..34e621fe8 100644 --- a/src/FSharpPlus/Data/Validation.fs +++ b/src/FSharpPlus/Data/Validation.fs @@ -49,6 +49,17 @@ module Validation = | Success _ , Failure e2 -> Failure e2 | Success f , Success a -> Success (f a) + let inline zip x y : Validation<'Error, 'T *'U> = + match (x: Validation<'Error, 'T>), (y: Validation<'Error, 'U>) with + #if !FABLE_COMPILER + | Failure e1, Failure e2 -> Failure (plus e1 e2) + #else + | Failure e1, Failure e2 -> Failure (e1 + e2) + #endif + | Failure e1, Success _ -> Failure e1 + | Success _ , Failure e2 -> Failure e2 + | Success x , Success y -> Success (x, y) + let inline map2 f x y : Validation<'Error,'V> = match (x: Validation<'Error,'T>), (y: Validation<'Error,'U>) with #if !FABLE_COMPILER @@ -281,6 +292,21 @@ type Validation<'error, 't> with [] static member inline Lift3 (f, x: Validation<'Error, 'T>, y: Validation<_, 'U>, z: Validation<_, 'V>) : Validation<_, 'W> = Validation.map3 f x y z + // as ZipApplicative (same behavior) + [] + static member inline Zip (x: Validation<'Error, 'T>, y: Validation<'Error, 'U>) : Validation<'Error, 'T * 'U> = Validation.zip x y + + [] + static member Pure x = Success x + + static member inline (<.>) (f: Validation<'Error, 'T -> 'U>, x: Validation<_, 'T>) : Validation<_, _> = Validation.apply f x + + [] + static member inline Map2 (f, x: Validation<'Error, 'T>, y: Validation<'Error, 'U>) : Validation<'Error, 'V> = Validation.map2 f x y + + [] + static member inline Map3 (f, x: Validation<'Error, 'T>, y: Validation<_, 'U>, z: Validation<_, 'V>) : Validation<_, 'W> = Validation.map3 f x y z + // as Alternative (inherits from Applicative) #if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 static member inline get_Empty () = Failure (getEmpty ()) From 50fb8a52a6dc545bbcf22c6a762835e31ebd36c5 Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Thu, 25 Jan 2024 09:53:20 +0100 Subject: [PATCH 22/27] Zip implementations for Result and Choice --- src/FSharpPlus/Control/Functor.fs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/FSharpPlus/Control/Functor.fs b/src/FSharpPlus/Control/Functor.fs index 2058fd069..8bf8e61f8 100644 --- a/src/FSharpPlus/Control/Functor.fs +++ b/src/FSharpPlus/Control/Functor.fs @@ -217,8 +217,9 @@ type Zip = static member Zip ((x: 'T [] , y: 'U [] , _output: ('T*'U) [] ), _mthd: Zip) = Array.zipShortest x y static member Zip ((x: ResizeArray<'T> , y: ResizeArray<'U> , _output: ResizeArray<'T*'U> ), _mthd: Zip) = ResizeArray.zipShortest x y static member Zip ((x: option<'T> , y: option<'U> , _output: option<'T*'U> ), _mthd: Zip) = Option.zip x y - static member Zip ((x: voption<'T> , y: voption<'U> , _output: voption<'T*'U> ), _mthd: Zip) = ValueOption.zip x y - static member Zip ((x: Result<'T, 'Error> , y: Result<'U, 'Error> , _output: Result<'T * 'U, 'Error> ), _mthd: Zip) = Result.zip x y + static member Zip ((x: voption<'T> , y: voption<'U> , _output: voption<'T*'U> ), _mthd: Zip) = ValueOption.zip x y + static member inline Zip ((x: Result<'T, 'Error> , y: Result<'U, 'Error> , _output: Result<'T * 'U, 'Error> ), _mthd: Zip) = Result.apply2With Plus.Invoke (fun a b -> a, b) x y + static member inline Zip ((x: Choice<'T, 'Error> , y: Choice<'U, 'Error> , _output: Choice<'T * 'U, 'Error> ), _mthd: Zip) = Choice.apply2With Plus.Invoke (fun a b -> a, b) x y static member Zip ((x: Async<'T> , y: Async<'U> , _output: Async<'T*'U> ), _mthd: Zip) = Async.zip x y #if !FABLE_COMPILER static member Zip ((x: Task<'T> , y: Task<'U> , _output: Task<'T*'U> ), _mthd: Zip) = Task.zip x y From 7c3203623034e1d4d4fe507fcead78748118063f Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Thu, 25 Jan 2024 11:54:08 +0100 Subject: [PATCH 23/27] Rename zapp to app --- docsrc/content/abstraction-zipapplicative.fsx | 2 +- src/FSharpPlus/Builders.fs | 10 +++++----- tests/FSharpPlus.Tests/Applicatives.fs | 2 +- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/docsrc/content/abstraction-zipapplicative.fsx b/docsrc/content/abstraction-zipapplicative.fsx index 9960006e6..8510c2bdb 100644 --- a/docsrc/content/abstraction-zipapplicative.fsx +++ b/docsrc/content/abstraction-zipapplicative.fsx @@ -127,7 +127,7 @@ let arr2 = (+) [|1;2;3|] <.> [|10;20;30|] // Validations -let validated = zapp2 { +let validated = app2 { let! x = async { return Ok 1 } and! y = async { return Ok 2 } and! z = async { return Error ["Error"] } diff --git a/src/FSharpPlus/Builders.fs b/src/FSharpPlus/Builders.fs index 47cce06ed..092c361d4 100644 --- a/src/FSharpPlus/Builders.fs +++ b/src/FSharpPlus/Builders.fs @@ -236,19 +236,19 @@ module GenericBuilders = /// Creates a strict monadic computation expression with side-effects (see http://fsprojects.github.io/FSharpPlus/computation-expressions.html for more information) let monad'<'``monad<'t>``> = new MonadFxStrictBuilder<'``monad<'t>``> () - /// Creates an applicative computation expression. + /// Creates a (sequential) applicative computation expression. let applicative<'``Applicative<'T>``> = ApplicativeBuilder<'``Applicative<'T>``> () - /// Creates an applicative computation expression which compose effects of two Applicatives. + /// Creates a (sequential) applicative computation expression which compose effects of two Applicatives. let applicative2<'``Applicative1>``> = ApplicativeBuilder2<'``Applicative1>``> () - /// Creates an applicative computation expression which compose effects of three Applicatives. + /// Creates a (sequential) applicative computation expression which compose effects of three Applicatives. let applicative3<'``Applicative1>>``> = ApplicativeBuilder3<'``Applicative1>>``> () /// Creates a (non sequential) applicative computation expression. - let zapp<'``Applicative<'T>``> = ZipApplicativeBuilder<'``Applicative<'T>``> () + let app<'``ZipApplicative<'T>``> = ZipApplicativeBuilder<'``ZipApplicative<'T>``> () /// Creates a (non sequential) applicative computation expression which compose effects of two Applicatives. - let zapp2<'``Applicative1>``> = ZipApplicativeBuilder2<'``Applicative1>``> () + let app2<'``ZipApplicative1>``> = ZipApplicativeBuilder2<'``ZipApplicative1>``> () #endif diff --git a/tests/FSharpPlus.Tests/Applicatives.fs b/tests/FSharpPlus.Tests/Applicatives.fs index 4cb1473ab..0de55822c 100644 --- a/tests/FSharpPlus.Tests/Applicatives.fs +++ b/tests/FSharpPlus.Tests/Applicatives.fs @@ -20,7 +20,7 @@ module Applicatives = [] let zipApply () = - let arr1 = zapp2 { + let arr1 = app2 { let! x1 = async { return [|1; 2; 3|] } and! x2 = async { return [|10; 20; 30|] } and! x3 = async { return [|100; 200; 300|] } From 7745364094acbac5d301d3f42392add989b11cf1 Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Sun, 28 Jan 2024 07:48:28 +0100 Subject: [PATCH 24/27] + Tests --- tests/FSharpPlus.Tests/Traversals.fs | 38 +++++++++++++++++++++++++++- 1 file changed, 37 insertions(+), 1 deletion(-) diff --git a/tests/FSharpPlus.Tests/Traversals.fs b/tests/FSharpPlus.Tests/Traversals.fs index c45cdcec2..51f892f3c 100644 --- a/tests/FSharpPlus.Tests/Traversals.fs +++ b/tests/FSharpPlus.Tests/Traversals.fs @@ -333,4 +333,40 @@ module Bitraversable = let _Const2 = bitraverse List.singleton List.singleton d let _Const3 = bitraverse NonEmptyList.singleton NonEmptyList.singleton e - () \ No newline at end of file + () + +module ZipApplicatives = + + [] + let transposeOptions () = + let a1 = nelist { Some 1; Some 2; Some 3 } + let a2 = transpose a1 + let a3 = transpose a2 + let b1 = [ Some 1; Some 2; Some 3 ] + let b2 = transpose b1 + let b3 = transpose b2 + let c1 = [| Some 1; Some 2; Some 3 |] + let c2 = transpose c1 + CollectionAssert.AreEqual (a1, a3) + CollectionAssert.AreEqual (b1, b3) + Assert.AreEqual (Some [|1; 2; 3|], c2) + + [] + let transposeCollections () = + let a1 = nelist { [1; 2]; [3; 4; 0]; [5; 6] } + let a2 = transpose a1 + let a3 = transpose a2 + let a4 = transpose a3 + let b1 = [ [1; 2]; [3; 4; 0]; [5; 6] ] + let b2 = transpose b1 + let b3 = transpose b2 + let b4 = transpose b3 + let c1 = [| Some 1; Some 2; Some 3 |] + let c2 = transpose c1 + let d1 = List.empty + let d2 = transpose d1 + let d3 = transpose d2 + CollectionAssert.AreEqual (a2, a4) + CollectionAssert.AreEqual (b2, b4) + Assert.AreEqual (Some [|1; 2; 3|], c2) + CollectionAssert.AreEqual (d1, d3) \ No newline at end of file From 233bbf3539b7298a1fc58be559a991f926cae165 Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Sun, 28 Jan 2024 08:23:28 +0100 Subject: [PATCH 25/27] Id as ZipApplicative --- src/FSharpPlus/Data/Identity.fs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/FSharpPlus/Data/Identity.fs b/src/FSharpPlus/Data/Identity.fs index e722c2a54..406b7d71a 100644 --- a/src/FSharpPlus/Data/Identity.fs +++ b/src/FSharpPlus/Data/Identity.fs @@ -22,13 +22,17 @@ module Identity = type Identity<'t> with static member Return x = Identity x : Identity<'T> + static member Pure x = Identity x : Identity<'T> static member Lift2 (f, Identity (x: 'T), Identity (y: 'U)) = Identity (f x y) : Identity<'V> static member Lift3 (f, Identity (x: 'T), Identity (y: 'U), Identity (z: 'V)) : Identity<'W> = Identity (f x y z) static member Map (Identity x, f : 'T->'U) = Identity (f x) : Identity<'U> + static member Map2 (f, Identity (x: 'T), Identity (y: 'U)) = Identity (f x y) : Identity<'V> + static member Map3 (f, Identity (x: 'T), Identity (y: 'U), Identity (z: 'V)) : Identity<'W> = Identity (f x y z) static member Zip (Identity x, Identity y) = Identity (x, y) : Identity<'T * 'U> static member (<*>) (Identity (f: 'T -> 'U), Identity (x: 'T)) : Identity<'U> = Identity (f x) + static member (<.>) (Identity (f: 'T -> 'U), Identity (x: 'T)) : Identity<'U> = Identity (f x) static member (>>=) (Identity x, f: 'T -> Identity<'U>) : Identity<'U> = f x From bb4d75a01f15482c484ef2a1c5b48b19a95a100b Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Sun, 28 Jan 2024 08:24:00 +0100 Subject: [PATCH 26/27] Adjust compiler messages --- src/FSharpPlus/Control/ZipApplicative.fs | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/src/FSharpPlus/Control/ZipApplicative.fs b/src/FSharpPlus/Control/ZipApplicative.fs index 3668ed8f6..3569acbad 100644 --- a/src/FSharpPlus/Control/ZipApplicative.fs +++ b/src/FSharpPlus/Control/ZipApplicative.fs @@ -13,6 +13,13 @@ open FSharpPlus open FSharpPlus.Data +[] +module ZipApplivativeConts = + let []MessagePure = "'Pure' operation is not defined for " + let []Code = 10707 + +open ZipApplivativeConts + type Pure = inherit Default1 static member inline InvokeOnInstance (x: 'T) = (^``ZipApplicative<'T>`` : (static member Pure : ^T -> ^``ZipApplicative<'T>``) x) @@ -38,7 +45,7 @@ type Pure = static member Pure (x: voption<'a> , _: Pure) = Return.Return (x, Unchecked.defaultof) static member Pure (_: list<'a> , _: Pure) = fun x -> List.cycle [x] : list<'a> - [] + [] static member Pure (x: 'a [] , _: Pure) = Return.Return (x, Unchecked.defaultof) static member Pure (x: 'r -> 'a , _: Pure) = Return.Return (x, Unchecked.defaultof) @@ -51,15 +58,15 @@ type Pure = static member Pure (x: Expr<'a> , _: Pure) = Return.Return (x, Unchecked.defaultof) #endif - [", 10720, IsError = true)>] + [.", Code, IsError = true)>] static member Pure (x: ResizeArray<'a>, _: Pure ) = Return.Return (x, Unchecked.defaultof) //Restricted - [] + [] static member Pure (_: string , _: Pure ) = fun (x: char) -> string x : string - [] + [] static member Pure (_: StringBuilder , _: Pure ) = fun (x: char) -> new StringBuilder (string x) : StringBuilder - [] + [] static member Pure (_: 'a Set , _: Pure ) = fun (x: 'a ) -> Set.singleton x static member Pure (_: 'a Set2 , _: Pure ) = fun (_: 'a ) -> Set2() : 'a Set2 From 0cbc83096bcf7682c0004dd30f61bf0f3265b0db Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Sun, 28 Jan 2024 09:14:08 +0100 Subject: [PATCH 27/27] Docs for traversable --- docsrc/content/abstraction-traversable.fsx | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/docsrc/content/abstraction-traversable.fsx b/docsrc/content/abstraction-traversable.fsx index 411cb8a52..85068e440 100644 --- a/docsrc/content/abstraction-traversable.fsx +++ b/docsrc/content/abstraction-traversable.fsx @@ -21,8 +21,20 @@ Minimal complete definition * ``traverse f x`` | ``sequence x`` *) (** - static member Traverse (t:'Traversable<'T>, f: 'T -> 'Functor<'U>) : 'Functor<'Traversable<'U>> - static member Sequence (t:'Traversable<'Functor<'T>>) : 'Functor<'Traversable<'T>> + static member Traverse (t: 'Traversable<'T>, f: 'T -> 'Applicative<'U>) : 'Applicative<'Traversable<'U>> + static member Sequence (t: 'Traversable<'Applicative<'T>>) : 'Applicative<'Traversable<'T>> +*) +(** + + +Other operations +---------------- + + * ``gather f x`` | ``transpose x`` (same as traverse and sequence but operating on ZipApplicatives) +*) +(** + static member Gather (t: 'Traversable<'T>, f: 'T -> 'ZipApplicative<'U>) : 'ZipApplicative<'Traversable<'U>> + static member Transpose (t: 'Traversable<'ZipApplicative<'T>>) : 'ZipApplicative<'Traversable<'T>> *) (**