SpecificCall on generic type methods

SpecificCall2.fsx

open System
open System.Reflection

open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.Patterns
open Microsoft.FSharp.Quotations.DerivedPatterns

type MethodInfo with
    /// Gets the underlying method definition
    /// including the supplied declaring type and method type arguments
    member m.GetUnderlyingMethodDefinition() : MethodInfo * Type[] * Type[] =
        let dt = m.DeclaringType
        if dt.IsGenericType then
            let gt = dt.GetGenericTypeDefinition()
            let gas = dt.GetGenericArguments()
            let mas = m.GetGenericArguments()

            let bindingFlags = 
                BindingFlags.Public ||| BindingFlags.NonPublic ||| 
                BindingFlags.Static ||| BindingFlags.Instance ||| 
                BindingFlags.FlattenHierarchy

            let m = 
                gt.GetMethods(bindingFlags) 
                |> Array.find (fun m' -> m.Name = m'.Name && m.MetadataToken = m'.MetadataToken)

            m, gas, mas

        elif m.IsGenericMethod then
            let mas = m.GetGenericArguments()
            m.GetGenericMethodDefinition(), [||], mas

        else
            m, [||], [||]

let (|SpecificCall2|_|) (pattern : Expr) =
    match pattern with
    | Lambdas(_, Call(_,mI,_)) | Call(_,mI,_) ->
        let gm,_,_ = mI.GetUnderlyingMethodDefinition()

        fun (input:Expr) ->
            match input with
            | Call(obj, mI', args) ->
                let gm',ta,ma = mI'.GetUnderlyingMethodDefinition()
                if gm = gm' then Some(obj, Array.toList ta, Array.toList ma, args)
                else None
            | _ -> None

    | _ -> invalidArg "pattern" "supplied pattern is not a method call"