From fb42bbf7b278a653b0799c1429dcd9e010d2fbc8 Mon Sep 17 00:00:00 2001 From: cannorin Date: Tue, 13 Sep 2022 15:02:21 +0900 Subject: [PATCH 1/3] Use reflection on Applicative.IsLeftZero --- src/FSharpPlus/Control/Applicative.fs | 63 ++++++++++++++++++++++++--- 1 file changed, 56 insertions(+), 7 deletions(-) diff --git a/src/FSharpPlus/Control/Applicative.fs b/src/FSharpPlus/Control/Applicative.fs index 400a3cef6..006013f9e 100644 --- a/src/FSharpPlus/Control/Applicative.fs +++ b/src/FSharpPlus/Control/Applicative.fs @@ -143,21 +143,70 @@ 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>() = + static let isLeftZero = + let ty = typeof<'a> + let check typedef = ty.IsGenericType && (ty.GetGenericTypeDefinition() = typedef) + let helperTy = typeof + let helper helperName tprms : 'a -> bool = + let meth = helperTy.GetMethod(helperName).MakeGenericMethod(tprms) + fun x -> meth.Invoke(null, [|box x|]) |> unbox + if check typedefof> then helper "Seq" (ty.GetGenericArguments()) + else if check typedefof> then helper "NonEmptySeq" (ty.GetGenericArguments()) + else if check typedefof> then helper "List" (ty.GetGenericArguments()) + else if ty.IsArray then helper "Array" [| ty.GetElementType() |] + else if check typedefof> then helper "Option" (ty.GetGenericArguments()) + else if check typedefof> then helper "Result" (ty.GetGenericArguments()) + else if check typedefof> then helper "Choice" (ty.GetGenericArguments()) + else + let isLeftZero = ty.GetMethod("IsLeftZero") + if not (isNull isLeftZero) then + let isLeftZero = + let targs = ty.GetGenericArguments() + if Array.isEmpty targs || not isLeftZero.ContainsGenericParameters then isLeftZero + else isLeftZero.MakeGenericMethod(targs) + (fun x -> isLeftZero.Invoke(null, [| box x |]) |> unbox) + else + let compareWith (obj: obj) = fun (x: 'a) -> obj.Equals(x) + 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 emptyMeth.Invoke(null, null) |> compareWith + else fun _ -> false + static member Invoke(x: 'a) = isLeftZero x +#endif + type IsLeftZero = inherit Default1 - static member IsLeftZero (t: ref> , _mthd: IsLeftZero) = Seq.isEmpty t.Value - static member IsLeftZero (_: ref>, _mthd: IsLeftZero) = false - static member IsLeftZero (t: ref> , _mthd: IsLeftZero) = List.isEmpty t.Value - static member IsLeftZero (t: ref> , _mthd: IsLeftZero) = Array.isEmpty t.Value - static member IsLeftZero (t: ref> , _mthd: IsLeftZero) = Option.isNone t.Value - static member IsLeftZero (t: ref> , _mthd: IsLeftZero) = match t.Value with Error _ -> true | _ -> false - static member IsLeftZero (t: ref> , _mthd: IsLeftZero) = match t.Value with Choice2Of2 _ -> true | _ -> false + static member IsLeftZero (t: ref> , _mthd: IsLeftZero) = IsLeftZeroHelper.Seq t.Value + static member IsLeftZero (t: ref>, _mthd: IsLeftZero) = IsLeftZeroHelper.NonEmptySeq t.Value + static member IsLeftZero (t: ref> , _mthd: IsLeftZero) = IsLeftZeroHelper.List t.Value + static member IsLeftZero (t: ref> , _mthd: IsLeftZero) = IsLeftZeroHelper.Array t.Value + static member IsLeftZero (t: ref> , _mthd: IsLeftZero) = IsLeftZeroHelper.Option t.Value + static member IsLeftZero (t: ref> , _mthd: IsLeftZero) = IsLeftZeroHelper.Result t.Value + static member IsLeftZero (t: ref> , _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, x) + #endif static member inline InvokeOnInstance (x: '``Applicative<'T>``) : bool = ((^``Applicative<'T>``) : (static member IsLeftZero : _ -> _) x) From 0023668b817635cf85b15b97e11161180c9f8127 Mon Sep 17 00:00:00 2001 From: cannorin Date: Tue, 13 Sep 2022 17:56:44 +0900 Subject: [PATCH 2/3] Catch if try to call an inline method and fail --- src/FSharpPlus/Control/Applicative.fs | 58 ++++++++++++++++++--------- 1 file changed, 40 insertions(+), 18 deletions(-) diff --git a/src/FSharpPlus/Control/Applicative.fs b/src/FSharpPlus/Control/Applicative.fs index 006013f9e..0b79612ff 100644 --- a/src/FSharpPlus/Control/Applicative.fs +++ b/src/FSharpPlus/Control/Applicative.fs @@ -154,6 +154,11 @@ type IsLeftZeroHelper = #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) @@ -161,30 +166,47 @@ type IsLeftZeroHelper<'a>() = let helper helperName tprms : 'a -> bool = let meth = helperTy.GetMethod(helperName).MakeGenericMethod(tprms) fun x -> meth.Invoke(null, [|box x|]) |> unbox - if check typedefof> then helper "Seq" (ty.GetGenericArguments()) - else if check typedefof> then helper "NonEmptySeq" (ty.GetGenericArguments()) - else if check typedefof> then helper "List" (ty.GetGenericArguments()) + let targs = ty.GetGenericArguments() + if check typedefof> then helper "Seq" targs + else if check typedefof> then helper "NonEmptySeq" targs + else if check typedefof> then helper "List" targs else if ty.IsArray then helper "Array" [| ty.GetElementType() |] - else if check typedefof> then helper "Option" (ty.GetGenericArguments()) - else if check typedefof> then helper "Result" (ty.GetGenericArguments()) - else if check typedefof> then helper "Choice" (ty.GetGenericArguments()) + else if check typedefof> then helper "Option" targs + else if check typedefof> then helper "Result" targs + else if check typedefof> 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 = - let targs = ty.GetGenericArguments() - if Array.isEmpty targs || not isLeftZero.ContainsGenericParameters then isLeftZero - else isLeftZero.MakeGenericMethod(targs) - (fun x -> isLeftZero.Invoke(null, [| box x |]) |> unbox) + 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) - 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 emptyMeth.Invoke(null, null) |> compareWith - else fun _ -> false - static member Invoke(x: 'a) = isLeftZero 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 = From f42cd3dabd37e4849e8f0b3d374dfed14e7684f9 Mon Sep 17 00:00:00 2001 From: cannorin <13620400+cannorin@users.noreply.github.com> Date: Thu, 15 Sep 2022 14:27:08 +0900 Subject: [PATCH 3/3] s/else if/elif/g --- src/FSharpPlus/Control/Applicative.fs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/FSharpPlus/Control/Applicative.fs b/src/FSharpPlus/Control/Applicative.fs index 0b79612ff..fc99c33eb 100644 --- a/src/FSharpPlus/Control/Applicative.fs +++ b/src/FSharpPlus/Control/Applicative.fs @@ -168,12 +168,12 @@ type IsLeftZeroHelper<'a>() = fun x -> meth.Invoke(null, [|box x|]) |> unbox let targs = ty.GetGenericArguments() if check typedefof> then helper "Seq" targs - else if check typedefof> then helper "NonEmptySeq" targs - else if check typedefof> then helper "List" targs - else if ty.IsArray then helper "Array" [| ty.GetElementType() |] - else if check typedefof> then helper "Option" targs - else if check typedefof> then helper "Result" targs - else if check typedefof> then helper "Choice" targs + elif check typedefof> then helper "NonEmptySeq" targs + elif check typedefof> then helper "List" targs + elif ty.IsArray then helper "Array" [| ty.GetElementType() |] + elif check typedefof> then helper "Option" targs + elif check typedefof> then helper "Result" targs + elif check typedefof> then helper "Choice" targs else let makeGeneric (mi: Reflection.MethodInfo) = if Array.isEmpty targs || not mi.ContainsGenericParameters then mi @@ -244,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 \ No newline at end of file +#endif