Skip to content

Instantly share code, notes, and snippets.

Show Gist options
  • Save schuster-rainer/1087843 to your computer and use it in GitHub Desktop.
Save schuster-rainer/1087843 to your computer and use it in GitHub Desktop.
#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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment