DynamicBinderImpl.fs

#if INTERACTIVE
#r "Microsoft.CSharp.dll"
#endif

open System
open System.Dynamic
open System.Linq.Expressions
open System.Reflection
open System.Runtime.CompilerServices
open Microsoft.CSharp.RuntimeBinder
open Microsoft.FSharp.Reflection

let (?)  (targetObject : obj) (targetMember:string)  : 'TargetResult  = 
    let targetResultType = typeof<'TargetResult>
    if not (FSharpType.IsFunction targetResultType)
    then 
        let cs = CallSite<Func<CallSite, obj, obj>>.Create(Binder.GetMember(CSharpBinderFlags.None, targetMember, null, [| CSharpArgumentInfo.Create(CSharpArgumentInfoFlags.None, null) |]))
        unbox (cs.Target.Invoke(cs, targetObject))
    else
        if not (FSharpType.IsFunction targetResultType) then failwithf "%A is not a function type" targetResultType 
        let domainType,_ = FSharpType.GetFunctionElements targetResultType
        let domainTypes = 
            if FSharpType.IsTuple domainType then FSharpType.GetTupleElements domainType 
            elif domainType = typeof<unit> then [| |]
            else [|domainType|]
        let objToObjFunction = 
           (fun argObj ->
             let realArgs = 
               match domainTypes with 
               | [|  |] -> [| |]
               | [| argTy |] -> [| argObj |]
               | argTys -> FSharpValue.GetTupleFields(argObj)
             
             let funcType = Expression.GetFuncType [| yield typeof<CallSite>; yield typeof<obj>; yield! domainTypes; yield typeof<obj> |]
             let cty = typedefof<CallSite<_>>.MakeGenericType [| funcType |]
             let cs = cty.InvokeMember("Create", BindingFlags.Public ||| BindingFlags.Static ||| BindingFlags.InvokeMethod, null, null, [|(box(Binder.InvokeMember(CSharpBinderFlags.None, targetMember, null, null, Array.create (realArgs.Length + 1) (CSharpArgumentInfo.Create(CSharpArgumentInfoFlags.None, targetMember)))))|])
                        |> unbox<CallSite>
             let target = cs.GetType().GetField("Target").GetValue(cs)
             target.GetType().InvokeMember("Invoke", BindingFlags.Public ||| BindingFlags.Instance ||| BindingFlags.InvokeMethod, null, target, [| yield box cs; yield box targetObject; yield! realArgs |])
             )
        let atyFunction = FSharpValue.MakeFunction(targetResultType,objToObjFunction)
        unbox<'TargetResult> atyFunction

let (?<-) (targetObject : obj) (targetMember : string) (args : 'Args) : unit =
  let argumentInfos = [| CSharpArgumentInfo.Create(CSharpArgumentInfoFlags.None, null); 
                         CSharpArgumentInfo.Create(CSharpArgumentInfoFlags.Constant ||| CSharpArgumentInfoFlags.UseCompileTimeType, null) |]
  let binder = Binder.SetMember(CSharpBinderFlags.None, 
                                targetMember, 
                                targetObject.GetType(),
                                argumentInfos)
  let setterSite = CallSite<Func<CallSite, obj, 'Args, obj>>.Create(binder)
  setterSite.Target.Invoke(setterSite, targetObject, args) |> ignore