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 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - + + + + + + + + - - - + + +