Skip to content

Make left zero dynamic (rewrite) #503

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Sep 15, 2022
Merged

Make left zero dynamic (rewrite) #503

Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
fb42bbf
Use reflection on Applicative.IsLeftZero
cannorin Sep 13, 2022
0023668
Catch if try to call an inline method and fail
cannorin Sep 13, 2022
f42cd3d
s/else if/elif/g
cannorin Sep 15, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
87 changes: 79 additions & 8 deletions src/FSharpPlus/Control/Applicative.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -143,21 +143,92 @@ type Lift3 with
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
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)

type IsLeftZeroHelper =
static member Seq (xs: seq<'t>) = Seq.isEmpty xs
static member NonEmptySeq (_: NonEmptySeq<'t>) = false
static member List (xs: list<'t>) = List.isEmpty xs
static member Array (xs: array<'t>) = Array.isEmpty xs
static member Option (x: option<'t>) = Option.isNone x
static member Result (x: Result<'t, 'u>) = match x with Error _ -> true | _ -> false
static member Choice (x: Choice<'t, 'u>) = match x with Choice2Of2 _ -> true | _ -> false

#if !FABLE_COMPILER
type IsLeftZeroHelper<'a>() =
/// turns false if
/// - it should always return false because neither `IsLeftZero` nor `Empty` are present
/// - the target method is inlined and cannot be called through reflection
static let mutable isValid = true

static let isLeftZero =
let ty = typeof<'a>
let check typedef = ty.IsGenericType && (ty.GetGenericTypeDefinition() = typedef)
let helperTy = typeof<IsLeftZeroHelper>
let helper helperName tprms : 'a -> bool =
let meth = helperTy.GetMethod(helperName).MakeGenericMethod(tprms)
fun x -> meth.Invoke(null, [|box x|]) |> unbox
let targs = ty.GetGenericArguments()
if check typedefof<seq<_>> then helper "Seq" targs
elif check typedefof<NonEmptySeq<_>> then helper "NonEmptySeq" targs
elif check typedefof<list<_>> then helper "List" targs
elif ty.IsArray then helper "Array" [| ty.GetElementType() |]
elif check typedefof<option<_>> then helper "Option" targs
elif check typedefof<Result<_, _>> then helper "Result" targs
elif check typedefof<Choice<_, _>> then helper "Choice" targs
else
let makeGeneric (mi: Reflection.MethodInfo) =
if Array.isEmpty targs || not mi.ContainsGenericParameters then mi
else mi.MakeGenericMethod(targs)
let isInlineError (e: Reflection.TargetInvocationException) =
match e.InnerException with
| :? NotSupportedException -> true
| _ -> false
let isLeftZero = ty.GetMethod("IsLeftZero")
if not (isNull isLeftZero) then
let isLeftZero = makeGeneric isLeftZero
(fun x ->
try
isLeftZero.Invoke(null, [| box x |]) |> unbox
with
| :? Reflection.TargetInvocationException as e when isInlineError e ->
isValid <- false; false)
else
let fallback = fun _ -> false
let compareWith (obj: obj) = fun (x: 'a) -> obj.Equals(x)
try
let emptyProp = ty.GetProperty("Empty")
if not (isNull emptyProp) then emptyProp.GetValue(null) |> compareWith
else
let emptyMeth = ty.GetMethod("get_Empty", [||])
if not (isNull emptyMeth) then
let emptyMeth = makeGeneric emptyMeth
emptyMeth.Invoke(null, [||]) |> compareWith
else isValid <- false; fallback
with
| :? Reflection.TargetInvocationException as e when isInlineError e -> isValid <- false; fallback

static member Invoke(x: 'a) = isValid && isLeftZero x
#endif

type IsLeftZero =
inherit Default1

static member IsLeftZero (t: ref<seq<_>> , _mthd: IsLeftZero) = Seq.isEmpty t.Value
static member IsLeftZero (_: ref<NonEmptySeq<_>>, _mthd: IsLeftZero) = false
static member IsLeftZero (t: ref<list<_>> , _mthd: IsLeftZero) = List.isEmpty t.Value
static member IsLeftZero (t: ref<array<_>> , _mthd: IsLeftZero) = Array.isEmpty t.Value
static member IsLeftZero (t: ref<option<_>> , _mthd: IsLeftZero) = Option.isNone t.Value
static member IsLeftZero (t: ref<Result<_,_>> , _mthd: IsLeftZero) = match t.Value with Error _ -> true | _ -> false
static member IsLeftZero (t: ref<Choice<_,_>> , _mthd: IsLeftZero) = match t.Value with Choice2Of2 _ -> true | _ -> false
static member IsLeftZero (t: ref<seq<_>> , _mthd: IsLeftZero) = IsLeftZeroHelper.Seq t.Value
static member IsLeftZero (t: ref<NonEmptySeq<_>>, _mthd: IsLeftZero) = IsLeftZeroHelper.NonEmptySeq t.Value
static member IsLeftZero (t: ref<list<_>> , _mthd: IsLeftZero) = IsLeftZeroHelper.List t.Value
static member IsLeftZero (t: ref<array<_>> , _mthd: IsLeftZero) = IsLeftZeroHelper.Array t.Value
static member IsLeftZero (t: ref<option<_>> , _mthd: IsLeftZero) = IsLeftZeroHelper.Option t.Value
static member IsLeftZero (t: ref<Result<_,_>> , _mthd: IsLeftZero) = IsLeftZeroHelper.Result t.Value
static member IsLeftZero (t: ref<Choice<_,_>> , _mthd: IsLeftZero) = IsLeftZeroHelper.Choice t.Value

#if !FABLE_COMPILER
static member Invoke (x: '``Applicative<'T>``) : bool =
IsLeftZeroHelper<'``Applicative<'T>``>.Invoke(x)
#else
static member inline Invoke (x: '``Applicative<'T>``) : bool =
let inline call (mthd : ^M, input: ^I) =
((^M or ^I) : (static member IsLeftZero : _*_ -> _) ref input, mthd)
call(Unchecked.defaultof<IsLeftZero>, x)
#endif

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

#endif
#endif