reflection op.fsx

open System
open System.Reflection

let rec matchTypeParameters (t1 : Type) (t2 : Type) = 
    if t1.IsGenericParameter then 
        Seq.singleton (t1,t2)
    else
        let ga1 = t1.GetGenericArguments()
        let ga2 = t2.GetGenericArguments()
        if ga1.Length <> ga2.Length then 
            Seq.empty
        else 
            (ga1,ga2) ||> Seq.map2 matchTypeParameters |> Seq.concat
let candidateMethods name (argsV : obj[]) (tp : Type) =
    tp.GetMethods(unbox(box -1))
    |> Array.choose 
        (fun n -> 
            if n.Name <> name then 
                None
            elif not n.IsGenericMethod then 
                Some (n :> MethodBase)
            else
                let parameters = n.GetGenericMethodDefinition().GetParameters()
                if parameters.Length <> argsV.Length then 
                    None
                else
                    let boundTypeParameters = 
                        (parameters,argsV)
                        ||> Seq.map2
                            (fun p a -> 
                                if p.ParameterType.ContainsGenericParameters then 
                                    matchTypeParameters p.ParameterType (a.GetType())
                                else Seq.empty
                            )
                        |> Seq.concat
                        |> Seq.toArray
                    let genericArgs = n.GetGenericArguments()
                    let boundGenericArgs = 
                        genericArgs
                        |> Array.choose 
                            (fun i -> 
                                boundTypeParameters 
                                |> Array.tryPick (fun (genParam, boundType) -> if genParam = i then Some boundType else None)
                            )
                    if genericArgs.Length <> boundGenericArgs.Length then 
                        None 
                    else 
                        Some(n.MakeGenericMethod(boundGenericArgs) :> MethodBase)
        )


let tryBindMethod name argsV (tp : Type) =
    match candidateMethods name argsV tp with
    | [||] -> None
    | methods ->
        let mutable args = argsV
        let mutable state = null
        try 
            Some(Type.DefaultBinder.BindToMethod(unbox (box -1), methods, &args, null, null, null, &state))
        with 
        | _ -> None


let findType (name : string) = System.AppDomain.CurrentDomain.GetAssemblies() |> Seq.pick (fun x -> x.GetType(name,false) |> Option.ofObj)
let (?) (o : obj) mname (p : 'a) = 
    let t,x = 
        match o with 
        | :? System.Type as t -> t,null
        | :? string as tn -> findType tn, null
        | _ -> o.GetType(),o
    let ps = 
        if FSharp.Reflection.FSharpType.IsTuple(typeof<'a>) then 
            FSharp.Reflection.FSharpValue.GetTupleFields(p)
        elif typeof<'a> = typeof<unit> then 
            [||]
        else
            [|box p|]
    match mname with 
    | "_ctor" -> Activator.CreateInstance(t,unbox(box -1),null,ps,null)
    | _ -> 
        match tryBindMethod mname ps t with 
        | Some null
        | None -> 
            match tryBindMethod ("get_" + mname) ps t with 
            | Some null
            | None -> 
                match t.GetField(mname,unbox(box -1)) with 
                | null -> 
                    let sc = "; "
                    match x with 
                    | null -> 
                            printfn $"{mname} not found in {t.GetMembers(BindingFlags.Instance ^^^ unbox(box -1)) |> Seq.distinct |> Seq.map (fun x -> x.Name) |> String.concat sc} "
                    | _ -> 
                        printfn $"{mname} not found in {t.GetMembers(BindingFlags.Static ^^^ unbox(box -1)) |> Seq.distinct |> Seq.map (fun x -> x.Name) |> String.concat sc} "
                    null
                | f -> f.GetValue(o)
            | Some m -> m.Invoke(x,ps)
        | Some m -> m.Invoke(x,ps)