@@ -143,21 +143,92 @@ type Lift3 with
143
143
static member inline Lift3 ( _ , ( _ : 't when 't : null and 't : struct , _ : ^u when ^u : null and ^u : struct , _ : ^v when ^v : null and ^v : struct ), _mthd : Default1 ) = id
144
144
static member inline Lift3 ( f : 'T -> 'U -> 'V -> 'W , ( x : '``Applicative < 'T > ``, y: '``Applicative<'U>`` , z : '``Applicative < 'V > ``) , _mthd : Default1 ) = ((^ `` Applicative<'T> `` or ^ `` Applicative<'U> `` or ^ `` Applicative<'V> `` ) : ( static member Lift3 : _*_*_*_ -> _) f, x, y, z)
145
145
146
+ type IsLeftZeroHelper =
147
+ static member Seq ( xs : seq < 't >) = Seq.isEmpty xs
148
+ static member NonEmptySeq ( _ : NonEmptySeq < 't >) = false
149
+ static member List ( xs : list < 't >) = List.isEmpty xs
150
+ static member Array ( xs : array < 't >) = Array.isEmpty xs
151
+ static member Option ( x : option < 't >) = Option.isNone x
152
+ static member Result ( x : Result < 't , 'u >) = match x with Error _ -> true | _ -> false
153
+ static member Choice ( x : Choice < 't , 'u >) = match x with Choice2Of2 _ -> true | _ -> false
154
+
155
+ #if ! FABLE_ COMPILER
156
+ type IsLeftZeroHelper< 'a>() =
157
+ /// turns false if
158
+ /// - it should always return false because neither `IsLeftZero` nor `Empty` are present
159
+ /// - the target method is inlined and cannot be called through reflection
160
+ static let mutable isValid = true
161
+
162
+ static let isLeftZero =
163
+ let ty = typeof< 'a>
164
+ let check typedef = ty.IsGenericType && ( ty.GetGenericTypeDefinition() = typedef)
165
+ let helperTy = typeof< IsLeftZeroHelper>
166
+ let helper helperName tprms : 'a -> bool =
167
+ let meth = helperTy.GetMethod( helperName) .MakeGenericMethod( tprms)
168
+ fun x -> meth.Invoke( null , [| box x|]) |> unbox
169
+ let targs = ty.GetGenericArguments()
170
+ if check typedefof< seq<_>> then helper " Seq" targs
171
+ elif check typedefof< NonEmptySeq<_>> then helper " NonEmptySeq" targs
172
+ elif check typedefof< list<_>> then helper " List" targs
173
+ elif ty.IsArray then helper " Array" [| ty.GetElementType() |]
174
+ elif check typedefof< option<_>> then helper " Option" targs
175
+ elif check typedefof< Result<_, _>> then helper " Result" targs
176
+ elif check typedefof< Choice<_, _>> then helper " Choice" targs
177
+ else
178
+ let makeGeneric ( mi : Reflection.MethodInfo ) =
179
+ if Array.isEmpty targs || not mi.ContainsGenericParameters then mi
180
+ else mi.MakeGenericMethod( targs)
181
+ let isInlineError ( e : Reflection.TargetInvocationException ) =
182
+ match e.InnerException with
183
+ | :? NotSupportedException -> true
184
+ | _ -> false
185
+ let isLeftZero = ty.GetMethod( " IsLeftZero" )
186
+ if not ( isNull isLeftZero) then
187
+ let isLeftZero = makeGeneric isLeftZero
188
+ ( fun x ->
189
+ try
190
+ isLeftZero.Invoke( null , [| box x |]) |> unbox
191
+ with
192
+ | :? Reflection.TargetInvocationException as e when isInlineError e ->
193
+ isValid <- false ; false )
194
+ else
195
+ let fallback = fun _ -> false
196
+ let compareWith ( obj : obj ) = fun ( x : 'a ) -> obj.Equals( x)
197
+ try
198
+ let emptyProp = ty.GetProperty( " Empty" )
199
+ if not ( isNull emptyProp) then emptyProp.GetValue( null ) |> compareWith
200
+ else
201
+ let emptyMeth = ty.GetMethod( " get_Empty" , [||])
202
+ if not ( isNull emptyMeth) then
203
+ let emptyMeth = makeGeneric emptyMeth
204
+ emptyMeth.Invoke( null , [||]) |> compareWith
205
+ else isValid <- false ; fallback
206
+ with
207
+ | :? Reflection.TargetInvocationException as e when isInlineError e -> isValid <- false ; fallback
208
+
209
+ static member Invoke ( x : 'a ) = isValid && isLeftZero x
210
+ #endif
211
+
146
212
type IsLeftZero =
147
213
inherit Default1
148
214
149
- static member IsLeftZero ( t : ref < seq < _ >> , _mthd : IsLeftZero ) = Seq.isEmpty t.Value
150
- static member IsLeftZero ( _ : ref < NonEmptySeq < _ >>, _mthd : IsLeftZero ) = false
151
- static member IsLeftZero ( t : ref < list < _ >> , _mthd : IsLeftZero ) = List.isEmpty t.Value
152
- static member IsLeftZero ( t : ref < array < _ >> , _mthd : IsLeftZero ) = Array.isEmpty t.Value
153
- static member IsLeftZero ( t : ref < option < _ >> , _mthd : IsLeftZero ) = Option.isNone t.Value
154
- static member IsLeftZero ( t : ref < Result < _ , _ >> , _mthd : IsLeftZero ) = match t.Value with Error _ -> true | _ -> false
155
- static member IsLeftZero ( t : ref < Choice < _ , _ >> , _mthd : IsLeftZero ) = match t.Value with Choice2Of2 _ -> true | _ -> false
215
+ static member IsLeftZero ( t : ref < seq < _ >> , _mthd : IsLeftZero ) = IsLeftZeroHelper.Seq t.Value
216
+ static member IsLeftZero ( t : ref < NonEmptySeq < _ >>, _mthd : IsLeftZero ) = IsLeftZeroHelper.NonEmptySeq t.Value
217
+ static member IsLeftZero ( t : ref < list < _ >> , _mthd : IsLeftZero ) = IsLeftZeroHelper.List t.Value
218
+ static member IsLeftZero ( t : ref < array < _ >> , _mthd : IsLeftZero ) = IsLeftZeroHelper.Array t.Value
219
+ static member IsLeftZero ( t : ref < option < _ >> , _mthd : IsLeftZero ) = IsLeftZeroHelper.Option t.Value
220
+ static member IsLeftZero ( t : ref < Result < _ , _ >> , _mthd : IsLeftZero ) = IsLeftZeroHelper.Result t.Value
221
+ static member IsLeftZero ( t : ref < Choice < _ , _ >> , _mthd : IsLeftZero ) = IsLeftZeroHelper.Choice t.Value
156
222
223
+ #if ! FABLE_ COMPILER
224
+ static member Invoke ( x : '``Applicative < 'T > ``) : bool =
225
+ IsLeftZeroHelper< '`` Applicative<'T> `` >. Invoke( x)
226
+ #else
157
227
static member inline Invoke ( x : '``Applicative < 'T > ``) : bool =
158
228
let inline call ( mthd : ^M , input : ^I ) =
159
229
(( ^M or ^I ) : ( static member IsLeftZero : _*_ -> _) ref input, mthd)
160
230
call( Unchecked.defaultof< IsLeftZero>, x)
231
+ #endif
161
232
162
233
static member inline InvokeOnInstance ( x : '``Applicative < 'T > ``) : bool =
163
234
((^ `` Applicative<'T> `` ) : ( static member IsLeftZero : _ -> _) x)
@@ -173,4 +244,4 @@ type IsLeftZero with
173
244
static member inline IsLeftZero ( t : ref < '``Applicative < 'T > ``> , _mthd : Default1 ) = (^ `` Applicative<'T> `` : ( static member IsLeftZero : _ -> _) t.Value)
174
245
static member inline IsLeftZero ( _ : ref < ^t > when ^t : null and ^t : struct , _ : Default1 ) = ()
175
246
176
- #endif
247
+ #endif
0 commit comments