Skip to content

Commit bffed59

Browse files
authored
Make left zero dynamic (rewrite) (#503)
* Use reflection on Applicative.IsLeftZero * Catch if try to call an inline method and fail * s/else if/elif/g Co-authored-by: cannorin <cannorin@users.noreply.github.com>
1 parent efcfd89 commit bffed59

File tree

1 file changed

+79
-8
lines changed

1 file changed

+79
-8
lines changed

src/FSharpPlus/Control/Applicative.fs

Lines changed: 79 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -143,21 +143,92 @@ type Lift3 with
143143
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
144144
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)
145145

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+
146212
type IsLeftZero =
147213
inherit Default1
148214

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
156222

223+
#if !FABLE_COMPILER
224+
static member Invoke (x: '``Applicative<'T>``) : bool =
225+
IsLeftZeroHelper<'``Applicative<'T>``>.Invoke(x)
226+
#else
157227
static member inline Invoke (x: '``Applicative<'T>``) : bool =
158228
let inline call (mthd : ^M, input: ^I) =
159229
((^M or ^I) : (static member IsLeftZero : _*_ -> _) ref input, mthd)
160230
call(Unchecked.defaultof<IsLeftZero>, x)
231+
#endif
161232

162233
static member inline InvokeOnInstance (x: '``Applicative<'T>``) : bool =
163234
((^``Applicative<'T>``) : (static member IsLeftZero : _ -> _) x)
@@ -173,4 +244,4 @@ type IsLeftZero with
173244
static member inline IsLeftZero (t: ref<'``Applicative<'T>``> , _mthd: Default1) = (^``Applicative<'T>`` : (static member IsLeftZero : _ -> _) t.Value)
174245
static member inline IsLeftZero (_: ref< ^t> when ^t: null and ^t: struct, _: Default1) = ()
175246

176-
#endif
247+
#endif

0 commit comments

Comments
 (0)